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it  penetrates  the  floor,  ceiling,  and  each  wall.  The  total  radiant  energy  within  a given  room  is  then  the 
sum  of  the  energies  arriving  there  via  the  various  room-to-room  routes  within  the  building.  The  ratio  (in 
dB)  of  this  total  radiant  energy  density  to  the  energy  density  incident  upon  the  building  is  the 
attenuation,  or  shielding  effectiveness,  assigned  to  that  room. 

1 . 3 Outline 

Chapter  two  reviev?s  the  search  for  electrical  properties  of  common  building  materials,  and  the  mathe- 
matical expressions  used  to  compute  wall  attenuation  from  these  properties.  We  list  the  several  computer 
data  bases  consulted,  and  note  the  key  word  groups  that  summoned  the  most  useful  references.  Brief  deri- 
vations of  the  computation  expressions  are  given. 

In  chapter  three  v^e  present  the  theory  supporting  our  procedure  for  computing  the  attenuation  of 
electromagnetic  signals  by  buildings.  It  is  here  that  we  discuss  the  assumptions  in  the  formulation  of 
the  problem,  and  limitations  imposed  by  those  assumptions. 

Descriptions  of  the  data  entry  programs,  data  files,  and  the  computation  program  MASTER  constitute 
chapter  four.  This  material  documents  the  programs  and  will  he  of  interest  mainly  to  the  person  wishing 
to  know  more  about  their  workings.  (User  instructions  are  in  the  User's  Guide,  chapter  five.) 

Chapter  five  is  a guide  to  the  use  of  the  programs.  There  are  instructions  on  how  to  become  a time- 
share  user,  and  how  to  organize  data  and  enter  it  into  the  data  files.  Sample  data  tabulations  are  given; 
also  examples  of  computer  printouts  illustrating  user-computer  conversations  during  data  entry. 

In  chapter  six  are  the  results  of  building  attenuation  measurements  made  by  NBS  at  three  Army  instal- 
lations. Graphs  present  the  measured  data  (in  dB)  versus  frequency,  and  show  the  effect  of  the  direction 
of  incidence  (i.e.,  location  of  the  launching  antenna)  on  the  shielding  effectiveness  of  the  structures 
evaluated.  Building  floor  plans  show  measurement  locations  and  the  placement  of  launching  antennas. 

Conclusions  and  bibliography  are  chapters  seven  and  eight,  respectively.  Appendix  9.1  details  pro- 
cedures for  making  building  attenuation  measurements  and  assigning  estimated  uncertainty.  Appendices 
9. 2-9. 7 contains  the  listings  for  the  five  data  entry  programs,  and  for  the  computation  program  MASTER. 
Appendix  9.8  is  a set  of  copyahle  forms  for  tabulating  data  to  be  entered  into  the  data  files. 
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2.  SEARCH  FOR  AND  COMPUTATION  OF  ELECTR0MAGNT:TIC  PROPERTIES  OF  BUILDING  MATERIALS 


2 . 1 Introduction 

This  chapter  begins  with  a description  of  the  literature  search  for  data  on  the  shielding  effective- 
ness of  building  materials  and  of  buildings  themselves.  The  search  was  primarily  a computer  interrogation 
of  several  large  data  bases,  although  we  also  perused  locally  available  journals,  handbooks,  reports  and 
conference  proceedings.  This  extensive  search  yielded  only  a few  useful  references,  just  one  of  which 
furnished  us  with  most  of  our  experimental  data  on  conventional  building  materials. 

Our  computations  of  reflection  coefficient  and  attenuation  are  based  on  expressions  derived  in  most 
introductory  texts  on  electromagnetic  fields  or  electricity  and  magnetism.  We  briefly  discuss  these  ex- 
pressions and  their  use  in  obtaining  the  data  in  thirteen  tables  at  the  end  of  this  chapter. 

2.2  The  Literature  Search 

To  carry  out  the  computer  literature  search,  we  relied  on  the  expertise  of  Mrs.  Victoria  R.  Schneller 
of  Library  Services,  Environmental  Research  Laboratories,  National  Oceanic  and  Atmospheric  Administration, 
Boulder,  Colorado.  The  data  bases  consulted  were: 

• NTISearch,  the  computer  search  service  of  the  National  Technical  Information  Service  (NTIS)  of 
the  U.S.  Dept,  of  Commerce;  accesses  all  technical  abstracts  compiled  by  NTIS;  1964  - present. 

• INSPEC  (Information  Service  for  Physics,  Electrotechnology,  and  Control);  comprises  Physics 
Abstracts,  Electrical  and  Electronic  Abstracts,  and  Computer  and  Control  Abstracts;  established 
by  the  Institute  of  Electrical  Engineers  (England);  1969  - present. 

• Smithsonian  Scientific  Information  Exchange  (SSIE);  1977  - present. 

• COMPENDEX,  a data  base  of  the  Engineering  Index  Annual,  a yearly  publication  of  engineering  and 
engineering-related  abstracts;  1970  - present. 

• NSA,  the  Standards  and  Specifications  data  base  of  the  National  Standards  Association;  current 
standards . 

• SCISEARCH,  the  computer  file  of  the  Science  Citation  Index;  1974  - present. 

• DTIC  (Defense  Technical  Information  Center);  reports  on  research  and  development  supported  by 
the  Department  of  Defense;  1953-present. 

In  the  search  for  data  on  attenuation  of  electromagnetic  waves  by  building  materials,  typical  kf_> 
words  used  were:  electrical  conductivity,  permittivity,  building  material,  construction  material, 
radiofrequency,  electromagnetic  shielding. 
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The  best  report  for  experimental  data  on  shielding  effectiveness  of  building  materials  (Brennan,  et 
al.  [4])  was  obtained  from  the  NTIS  data  base  with  the  combined  key  words:  electrical  properties,  electri- 
cal conductivity,  permittivity,  building  materials,  electromagnetic  shielding,  radiofrequency,  construc- 
tion. A companion  paper  (Garrett  et  al.  [5])  was  obtained  using  the  same  key  words  but  omitting  "con- 
struction." This  selection  of  keywords  retrieved  papers  on  both  the  direct  measurement  of  electromagnetic 
attenuation  and  on  measurement  of  electrical  properties  from  which  attenuation  could  be  computed.  The 
DTIC  data  base  search  gave  the  Brennan  [4]  and  Garrett  [5]  reports  in  response  to  the  combined  key  words: 
building,  construction  materials,  dielectric  properties,  electrical  properties,  electrical  conductivity. 
Mrs.  Schneller  was  adept  at  using  different  combinations  of  key  words  to  make  an  interrogation  more  spe- 
cific . 

In  our  search  for  papers  on  the  attenuation  of  electromagnetic  (EM)  waves  by  buildings  (as  opposed  to 
building  materials),  we  used  key  word  groups  such  as:  EM  field,  EM  radiation,  EM  wave  absorption,  attenua- 
tion, shielding,  absorption,  building,  structure,  and  construction.  One  of  the  most  useful  papers  on 
building  attenuation  (Smith  [3])  had  been  entered  in  the  INSPEC  data  base  with  the  key  words:  electromag- 
netic compatibility,  electromagnetic  fields,  building,  shielding,  radiowave  propagation.  As  our  search 
progressed,  we  found  that  there  was  very  little  data  on  radiofrequency  attenuation  by  conventional  build- 
ing materials,  or  even  on  the  electrical  properties  of  such  materials. 

A computer  search  based  on  key  words  without  such  qualifiers  as  "electromagnetic"  and  "radiofre- 
quency" produces  references  on  the  attenuation  of  nuclear  as  well  as  electromagnetic  radiation.  Many 
papers  retrieved  by  key  words  specific  to  "radiofrequency  attenuation  by  buildings  and  building  materials" 
concerned  structures  hardened  to  electromagnetic  interference  by  specialized  construction  methods  and 
exotic  materials.  Often  these  structures  were  simply  shielded  rooms  or  no  more  than  screened  enclosures. 
Therefore,  although  our  search  was  extensive,  the  data  we  use  in  our  building  attenuation  computations  has 
come  from  just  a few  reports  which  are  identified  on  the  data  table  for  each  material. 

2.3  Computations 

The  three  types  of  materials  for  which  we  computed  shielding  properties  are  dielectrics,  metal 
sheets,  and  metal  meshes.  We  discuss  these  computations  in  that  order.  All  expressions  and  computed  data 
are  in  SI  units. 

Brennan  [4]  measured  the  real  and  imaginary  parts  of  the  complex  permittivity  of  common  building 
materials  as  a function  of  frequency  from  10  Hz  to  1 GHz.  (Because  of  the  variable  sensitivity  of  the 
measurement  apparatus  as  the  lossiness  of  the  materials  varied,  measurements  often  could  not  be  made  at 
each  of  the  intended  frequencies.)  From  these  permittivity  values,  we  computed  the  power  reflection  coef- 
ficient and  power  attenuation  (dB/cm)  for  each  material  in  decade  steps  at  frequencies  from  10  kHz  to  10 
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GHz.  If  data  was  not  available  at  a desired  frequency,  we  plotted  the  given  data  and  then  interpolated  or 
extrapolated  to  obtain  the  missing  point.  We  now  briefly  discuss  the  relations  used  in  our  computations. 

The  electrical  characteristics  of  a lossy,  isotropic  dielectric  are  given  by  its  complex  permittivity 
(see  any  text,  such  as  Johnk  [6]) 

e = e'  - j£"  (2.1) 

where  the  real  part,  e',  contains  information  on  the  speed  and  wavelength  of  an  EM  wave  in  the  dielectric 

(e'  corresponds  to  the  permittivity  e of  a lossless  dielectric).  The  imaginary  term  e"  accounts  for  the 

lossy  nature  of  the  dielectric  and  appears  in  expressions  for  the  EM  wave  attenuation  due  to  those  losses. 

■1/2 

Electromagnetic  waves  are  transmitted  through  a dielectric  (lossy  or  not)  with  the  velocity  v = (pe)  ' , 

- 1/2 

where  p is  the  permeability  of  the  medium.  (The  free  space  values  are  denoted  po,  £o>  v = (po^o)  ^ 

g 

S 3 X 10  m/s.  Air  can  be  considered  free  space.)  In  general,  s'  and  £"  are  functions  of  the  frequency 
of  the  EM  wave  traversing  the  dielectric,  as  observed  in  Brennan's  data. 

Given  two  adjoining  media  of  permittivities  s^  and  s^,  a wave  in  medium  1,  normally  incident  on  me- 
dium 2,  has  a voltage  reflection  coefficient  ([6],  p.  373) 


r = 


^2  - *1l 
ri2  + Hi  ’ 


= intrinsic  wave  impedance. 


Because  P2  = Po  for  most  building  materials  in  this  report,  and  because  medium  1 is  air,  we  can  write 


^ 1 “ 7^ 

r = , £ = £o/£n  = relative  permittivity, 

1+4“  r 2 0 

^ r 

where  medium  2 is  the  building.  The  power  reflection  coefficient  is  then 


1 - 

1 + 


To  determine  if  we  must  retain  £^  in  its  complex  form,  we  write 


£ = (£0  - j£o)  = £'  - j£" 

r £0  2 '’2  r r 


(2.2) 


= Ae'J®  ; A = [(£p^  + (£p^]^/^  ; 6 = tan”^£^/£p, 

and  so 

(£4^^^  = [(£p^  + ^ 
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For  the  materials  in  this  report  that  are  low-loss  dielectrics  (e"  <<  1),  we  neglect  and  approximate 
as  the  real  quantity  whose  magnitude  is  This  procedure  incurs  negligible  error  in  the  reflection 

coefficient,  the  worst  case  being  2.5%  (the  30  kHz  s',  e"  values  for  moist  clay  brick)  which  introduces  in 
eq  (2.2)  a deviation  from  the  true  reflected  power  of  only  0.1  dB.  With  the  above  approximation  for 
our  expression  for  the  power  reflection  coefficient  is 


(F)^  = 


,1  + ^/Fy 


(2.3) 


As  an  EM  wave  traverses  a lossy  dielectric,  it  is  attenuated;  that  is,  the  wave  amplitude  decreases 
with  distance.  We  represent  this  wave  as 


E^(z)  = Eo  e 


■yz  _ „ 

- Eo 


-(a  + j6)z  _ p -Ofz  -j6z 
? = Eo  e e 


where  the  E-field  vector  is  in  the  x direction,  and  the  wave  propagates  along  the  positive  z axis.  The 
exponential  factor,  Eo  e , represents  the  wave -amplitude  attenuation  with  distance;  a is  the  attenuation 
constant.  The  ratio  of  amplitudes  at  points  z and  z + £ is 


Eo  e 


■az 


Eo  e 


-a(z  + £) 


a£ 

e 


The  attenuation  of  power  density  in  the  wave  over  the  distance  £ is  the  square  of  this  ratio  and  is  e 
In  decibels,  this  attenuation  is 


attenuation  (dB)  = 10  log  e = 10  x 0.4342  In  e = 8.684a£ 


and  so 

attenuation  (dB/length)  = 8.684a  . (2.4) 

For  a wave  of  angular  frequency  U)  in  a dielectric  of  complex  permittivity  £'  - j£"  and  permeability 
p (=  po  For  dielectrics  considered  here)  we  have  (Johnk  [6],  p.  173) 

a = [Vl  + (£’’/£' )^  - 1]^^^  . (2.5) 

Brennan  has  given  his  values  of  £*,  e"  as  £'/£o  ^od  £"/£o  (~  £^)  which  he  calls  dielectric  con- 

stant ("relative  permittivity,"  in  Johnk)  and  dissipation  factor  (Johnk's  dissipation  factor  is  £"/£'). 

g 

Writing  a in  terms  of  these  quantities  (where  c ~ 3 x 10  m/s) 
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^^0  I T 1 /0  27lf'\/£  J £~  2 1/2 

a = — [Vi  + [VI  + (j^r  - iv'^ 

VF  V^c 


1.48  X 10"®  f V^  [ 

-V  J. 


/ 

Vi  + 


)2  . ijl/2 


(2.6) 


In  eq  (2.5),  the  factor  u)  Vm£  = 2n/A;  thus,  the  dimension  of  a is  (length)  In  metric  (S.I.)  units,  a 
has  the  dimension  (meter)  \ and  eq  (2.4)  will  be  in  dB/m.  For  our  purposes,  a more  reasonable  dimension 
is  dB/cm,  and  so  our  values  for  attenuation  were  computed  from  the  expression 

attenuation  (dB/cm)  = 0.08684a  , (2.7) 

with  a obtained  from  eq  (2.6). 

For  metals  and  materials  with  significant  conductivity,  a,  the  complex  permittivity  is  more 


appropriately  written 


£ = £-!-. 

lu 


Following  the  discussion  in  Johnk  ([6],  ch.  3),  the  corresponding  form  for  a is 


a = 


M |/l  + (-2)2  . i]l/2  ^ 

^ ^ LU£ 


(2.8) 


(2.9) 


For  metals  a ~ 10^  mhos/m.  Therefore,  even  at  10  GHz,  (|jjj^)^  » 1>  and  a can  be  written 


ui  Vm£  I ^ - / lupa  / 

“ ■ ^ Hi  " ^ 2.-^~  r~ 


where  is  relative  permeability,  is  conductivity  relative  to  copper,  and  is  the  conductivity  of 
ubstituting  po  = 

a = 15.13  VfM~o“ 


copper.  Substituting  po  = 4ti  x 10  ^ farads/meter  and  = 5.80  x lO^  mhos/meter,  we  have 


r r 


and  so 


attenuation  (dB/dm)  = 0.08684a  = 1.314  -Jf\j  o . 


r r 


(2.10) 


This  is  the  expression  in  Denny  ([7],  p.  5-6)  for  the  attenuation  of  an  EM  wave  traversing  a metal  sheet 
1 cm  thick.  With  eq  (2.10)  and  values  for  p^  and  from  Table  5-2  in  Denny,  we  computed  attenuation 
values  for  iron,  copper,  and  aluminum  sheets. 

For  a plane  wave  normally  incident  on  a surface,  the  incident,  reflected,  and  transmitted  powers  ar< 
related  as 

P.  = P + P_  , 

1 r t ’ 

2 

where  P^  is  the  wave  power  density  (w/cm  ) just  across  the  interface  and  before  the  wave  traverses  .iny  r.f 
the  medium  into  which  it  has  just  passed.  Then 
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1 


2 


and  so 

= 1 - (r^)^  (2.11) 

where  and  P^  are  the  magnitudes  of  voltage  reflection  and  transmission  coefficients,  and  their  squares 
are  power  reflection  and  transmission  coefficients.  In  Denny  ([7],  p.  5-5),  the  reflection  loss  in  dB  is 
given  as 

R = - 10  log  (P^)2  . (2.12) 


For  iron  and  copper,  R values  are  tabulated  in  Campi  ([8],  p.  28),  and  presented  graphically  for  iron, 

2 

copper,  and  aluminum  in  Denny  (p.  5-15).  Solving  eq  (2.12)  for  (P^,)  , we  have 


(r^)^  = 


10 


-R/IO 


and  we  write  the  power  reflection  coefficient  as 


(Pj.)^  = 1 - 10“^^^°  . (2.13) 

In  Denny  [7]  and  Campi  [8],  the  smallest  value  of  R is  57  dB  from  10  kHz  to  10  GHz.  Therefore,  we  set  the 

power  reflection  coefficient  to  unity  over  this  frequency  range  for  iron,  copper  and  aluminum. 

The  attenuation  of  plane  EM  waves  incident  normally  on  metal  wire  meshes  has  been  computed  by  Jakubec 

and  Ohta  [9],  and  we  give  their  attenuation  values  in  Tables  2.9  and  2.10  for  galvanized  steel  and  copper 

meshes.  Jarva  [10]  has  done  some  plane  wave  attenuation  computations  from  the  same  equations  and  his 
values  are  close  to  those  of  Jakubec  and  Ohta.  Some  measured  attenuations  quoted  by  Jarva  support  the 
computed  plane  wave  values.  The  theoretical  expressions  employed  in  both  reports  are  identical,  though 
Jarva  gives  their  derivations. 

The  mesh  attenuation  ("insertion  loss"  in  Jarva)  computed  by  Jakubec  and  Ohta  is  the  same  quantity  as 
R in  eq  (2.12).  Using  eq  (2.13)  and  attenuation  values  in  Tables  2.9  and  2.10  for  R,  we  see  that  we  are 
justified  in  setting  the  mesh  reflection  coefficients  to  unity. 

The  attenuation  and  reflection  coefficients  of  a reinforced  concrete  wall  are  almost  totally  due  to 
the  reinforcing  bars  ("rebars")  within  the  concrete.  The  low  shielding  effectiveness  of  concrete  alone  is 
seen  in  our  computations  of  attenuation  and  reflection  coefficients  from  Brennan's  permittivity  data  for 
moist  mortar  (Table  2.2).  ("Moist"  means  the  mortar  samples  were  exposed  to  a saturated  atmosphere  for 
one  day  prior  to  measurement.  Some  samples  were  measured  dry:  they  were  baked  at  140°F  for  about  20  hours 
prior  to  measurement.  However,  the  moist  samples  had  electrical  properties  most  similar  to  those  of  ma- 
terials in  field  conditions.)  There  are  many  types  of  concrete  reinforcing  structures.  In  some  cases, 
parallel  bars  without  cross  members  are  used;  the  bars  may  be  horizontal  or  vertical.  When  a mesh  is 
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used,  the  vertical  and  horizontal  bars  may  have  the  same  spacing  and  the  same  bar  diameters,  or  the  verti- 
cal bars  may  be  heavier  and  closer  together.  (Rebar  diameters  range  from  0.95  cm  to  6.4  cm.)  Thicker 
walls  may  have  two  reinforcing  layers:  a 20-cm  thick  concrete  wall  could  have  a rebar  layer  5 cm  in  from 
each  face.  Thus,  knowing  only  that  a concrete  wall  is  reinforced,  one  cannot  be  sure  of  the  reinforcing 
configuration.  We  use  a square  mesh  to  illustrate  how  rebar  shielding  may  vary  with  frequency. 

The  equations  presented  in  references  7,  9,  and  10  for  the  attenuation  of  plane  EM  waves  by  metal 
screens  are  based  on  the  transmission  of  evanescent  modes  through  a waveguide  below  cutoff.  However, 
reinforcing  meshes  in  concrete  have  such  large  openings  that  cutoff  occurs  at  much  lower  frequencies,  well 
into  the  frequency  range  (10  kHz  - 10  GHz)  considered  in  this  report.  Therefore,  we  compute  the  power 
reflection  coefficient  for  rebar  meshes  using  an  equation  developed  by  MacFarlane  ([11],  p.  1527)  for  the 
voltage  reflection  coefficient  for  plane  waves  incident  on  an  infinite  parallel-wire  grid,  the  plane  of 
polarization  parallel  to  the  grid.  Hill  and  Wait  [12]  obtain  the  same  expression  in  their  analysis  of  the 
scattering  of  a transient  plane  wave  by  a periodic  grating.  In  both  these  treatments  the  scattering 
structure  is  an  infinite  set  of  equally-spaced  parallel  wires;  there  are  no  cross  members,  unlike  the 
rebar  mesh  we  are  considering.  However,  Hill  and  Wait  [13,  14]  show  that,  for  normal  incidence,  the 
reflection  coefficient  obtained  by  MacFarlane  [11]  and  by  Hill  and  Wait  [12]  is  applicable  to  scattering 
from  a mesh.  For  waves  at  normal  incidence,  the  two  crossed  grids  forming  the  mesh  decouple  and  interact 
with  the  waves  as  separate,  independent  parallel-wire  grids,  each  responding  only  to  the  E-field  component 
along  it.  Thus,  when  the  plane  of  polarization  is  aligned  with  one  grid,  the  other  has  no  interaction 
with  the  waves  and  drops  out  of  the  analysis.  For  normal  incidence,  the  mesh  field  equations  obtained  by 
Hill  and  Wait  [13,  14]  yield  the  MacFarlane  expression  for  the  reflection  coefficient  of  a parallel-wire 
grid. 

The  decoupling  of  crossed  grids  of  parallel  wires  is  also  shown  by  Kontorovich  [15]  and  Astrakhan 
[16],  but  only  for  the  long-wavelength  condition  (d  <<  A,  d = separation  distance  between  wires  of  a grid). 
(Their  results  cannot  be  used  for  wavelengths  equal  to  or  less  than  d,  as  in  our  rebar  computations.)  The 
analysis  contains  a term  proportional  to  the  electrical  resistance  between  the  grids  at  the  points  where 
the  wires  of  one  grid  are  bonded  to  those  of  the  other.  The  reflection  coefficient  for  waves  at  normal 
incidence  does  not  depend  on  this  term  so  the  grids  are,  in  effect,  independent  elements  of  the  mesh.  For 
d <<  A,  MacFarlane 's  expression  for  the  normal  incidence  reflection  coefficient  of  a parallel-wire  grid 
reduces  to  the  expression  for  a mesh  [15,  16]. 

For  wavelengths  longer  than  the  wire  spacing,  the  power  reflection  coefficient  obtained  from  MarFar- 
lane  for  0°  angle-of-incidence  is 
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1 ^ [F(^,0«)  * in  5^)2 


(2.14) 


where  d = wire  spacing,  a = wire  radius.  For  ^ 1 (d  = wire  spacing),  F(^,  0®)  is  a real  factor  given 

graphically  in  references  11  and  12.  For  short  wavelengths  (^  > 1),  F becomes  complex  (F  = F^  + j F^), 

(2.15) 


and  values  for  F^  and  F^  are  also  plotted  [12].  The  power  reflection  coefficient  is  then 


ir  I 

r 


2d  „ s2  ,2d.2  ft,  , 1 d .2 


We  have  used  eqs  (2.14)  and  (2.15)  to  compute  the  plane-wave  power  reflection  coefficient  for  a square 
rebar  mesh. 

Campi  [8]  discussed  the  shielding  effectiveness  of  a rebar  mesh  having  d = 35.6  cm  and  a = 2.2  cm. 

We  used  these  dimensions  in  computing  rebar  power  reflection  coefficients  from  eqs  (2.14)  and  (2.15).  The 
definition  of  shielding  effectiveness  (SE)  for  any  shielding  material  is  ([7],  p.  5-2) 


P P 

SE  = 10  log  ^ = - 10  log  :^  = - 10  log  (r  )^  = attenuation  (dB) 

2 ^1 

where  (Pp  P2)  = power  density  (without,  with)  the  shield  in  place.  Then  we  use  eq  (2.11)  and  compute  the 
rebar  attenuation  from  the  expression 

attenuation  (dB)  = - 10  log  (T^)^  = - 10  log  (1  - (F^)^).  (2.16) 

We  summarize  our  computation  equations: 

• Power  reflection  coefficient  for  a dielectric  sheet:  eq  (2.3). 

• Power  attenuation  within  a dielectric  sheet:  eqs  (2.6),  (2.7). 

• Power  reflection  coefficient  for  a metal  sheet:  eq  (2.13). 

• Power  attenuation  within  a metal  sheet:  eq  (2.10). 

• Power  reflection  coefficient  for  a metal  screen:  eq  (2.13),  using  eq  (2.12). 

• Power  reflection  coefficient  for  a rebar  mesh:  eqs  (2.14),  (2.15). 

• Power  attenuation  (insertion  loss)  for  a rebar  mesh:  eq  (2.16). 

2.4.  Uncertainty 

For  the  quantities  we  have  computed  (reflection  coefficient,  attenuation  per  unit  length),  we  used 
expressions  derived  for  plane  waves  at  normal  incidence.  Into  these  expressions  we  put  measured  values 
for  the  real  and  imaginary  parts  of  the  complex  permittivity.  Thus,  our  computed  quantities  have  uncer- 
tainties originating  in  the  measured  data  we  obtained  in  our  literature  search.  (The  reports  from  which 
this  data  was  obtained  do  not  give  measurement  uncertainties.) 
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However,  we  must  include  additional  uncertainties  in  our  computed  data  to  account  for  other  factors 
which  influence  reflection  coefficients  and  attenuations.  For  example,  although  we  have  assumed  normal 
incidence,  waves  may  be  incident  at  angles  from  0°  to  90°.  A concern?  Yes.  Fresnel's  reflection  equa- 
tions tell  us  that  the  reflection  coefficient  depends  on  the  angle  of  incidence  and  the  orientation  of  the 
plane  of  polarization  with  respect  to  the  plane  of  incidence.  The  power  in  a reflected  wave  may  also  vary 
with  surface  dampness.  Another  factor  adding  to  the  uncertainty  in  our  data  is  the  dependence  of  wood 
permittivity  on  temperature  and  relative  humidity  [17],  on  the  angle  between  the  plane  of  incidence  and 
the  wood  grain  [17],  and  on  chemicals  used  in  treating  the  wood  [18].  There  may  be  other  less  determi- 
nate factors  contributing  to  deviations  from  our  computed  data,  factors  such  as  manufacturing  differences, 
age  of  materials,  and  surface  weathering. 

Because  our  computation  equations  were  derived  from  plane-wave  models,  they  contribute  further  to  the 
uncertainty  of  our  computed  data.  As  discussed  in  Denny  ([7],  section  5.3.2),  the  reflection  coefficient 
depends  on  the  intrinsic  impedance  of  the  incident  wave.  Plane  waves  have  an  intrinsic  impedance  of  about 
377  fi,  while  waves  in  the  near  fields  of  loop  and  dipole  antennas  are  not  planar  and  have  lower  and  higher 
impedances,  respectively.  These  three  types  of  electromagnetic  field  are  all  different  in  their  reflection 
loss  versus  frequency  curves.  The  reflection  loss  of  high  and  low  impedance  fields  also  depends  on  the 
distance  of  the  reflecting  surface  from  the  source  antenna.  Thus,  the  reflection  coefficients  we  have  com- 
puted will  differ  from  the  true  reflection  coefficient  when  the  incident  wave  is  something  other  than  plane. 

The  program  MASTER  computes  only  worst-case  values  for  building  attenuation  and  does  not  do  an  error 
analysis.  The  latter  would  be  of  little  use  considering  our  lack  of  detailed  information  on  radiation 
environments  and  building  structure  and  contents.  However,  to  acknowledge  the  "unknowable"  uncertainties 
introduced  into  our  data  by  the  various  factors  we  have  discussed,  we  suggest  the  following  broad  uncer- 
tainty estimates  for  the  quantities  specified: 

• 1%  - the  essentially  infinite  attenuations  and  unity  reflection  coefficients  of  metal  sheets  and 
meshes.  This  small  uncertainty  indicates  that  these  materials  have  a nearly  constant  effect 
versus  frequency  and  changing  environment. 

• 10%  - the  attenuations  of  the  dielectric  materials  (e.g.,  glass,  brick,  wood).  We  have  assigned 
this  higher  uncertainty  because  these  materials,  nearly  transparent  up  to  microwave  frequencies, 
are  the  major  reason  why  fields  so  easily  penetrate  conventional  buildings.  Variations  in  the 
electrical  properties  of  these  materials  will  alter  (though  only  slightly)  the  power  density  of 
waves  passing  through  them  into  building  interiors. 

‘ 100%  - the  reflection  coefficients  of  the  dielectric  materials.  This  large  uncertainty  should 

include  most  variations  in  reflection  coefficient  with  angle  of  incidence,  material  properties, 
and  environmental  conditions. 
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Note  that  these  uncertainties  are  in  the  reflected  and  attenuated  powers  and  not  in  the  decibel  per 
centimeter  values  for  attenuation. 


When  we  compute  the  plane-wave  shielding  effectiveness  of  a layer  of  construction  material  in  a wall, 
the  reflection  coefficient  of  the  material  tells  us  how  much  incident  power  is  turned  back  by  the  layer, 
and  the  attenuation  (dB/cm)  tells  us  how  much  power  is  absorbed  within  the  material  of  the  layer.  (By 
"power,"  we  mean  power  density  in  the  wave,  e.g. , W/cm  .)  Reflection  occurs  not  only  at  the  front,  but 
also  at  the  back  surface  of  the  layer.  Depending  on  the  reflection  coefficient  and  the  attenuation,  there 
may  be  enough  power  in  the  back  surface  reflection  that  the  succeeding  multiple  internal  reflections  with- 
in the  layer  must  be  considered  in  determining  the  net  transmission  through  the  layer  and  the  net  reflec- 
tion from  the  layer.  (In  this  regard,  solid  metal  shields  can  be  neglected.  They  have  such  high  attenua- 
tion that  little  or  no  electromagnetic  field  reaches  the  back  surface  of  the  shield.)  Common  building 
materials  are  dielectrics  with  very  low  attenuation  and  reflection  coefficients,  and  much  of  the  power  in 
the  incident  wave  passes  through  such  a material.  Therefore,  we  must  decide  if  it  is  sufficient  to  con- 
sider only  the  front  surface  reflection,  or  if  the  multiple  internal  reflections  within  a dielectric  layer 
should  be  taken  into  account. 

At  any  instant,  the  internal  reflections  within  a dielectric  sheet  produce  an  infinite  series  of 
waves  leaving  the  front  and  back  surfaces  of  the  sheet.  The  vector  addition  of  the  fields  in  these  waves 
gives  the  net  reflected  and  transmitted  wave.  However,  to  simplify  the  treatment  and  still  get  an  esti- 
mate of  the  reflected  and  transmitted  power,  we  assume  constructive  interference  between  all  the  emerging 
waves  and  so  add  their  powers  to  obtain  the  total  reflected  and  transmitted  power.  For  low-loss  dielec- 
trics, we  neglect  attenuation  within  the  material.  This  procedure  gives  the  total  reflected  power 


nv  r 

p = — = — p 
r 1 + (p  )2  0.- 


where  P^  is  the  power  density  of  the  incident  wave,  and  (F^)'^  is  the  power  reflection  coefficient.  The 
total  transmitted  power  is 

1 - (r 

p.  = — — ^ p . 


1 + (rj 


2 o 


For  our  dielectric  materials,  (F^)  <<  1,  and  we  can  write 


P = 2 (F  [1  - (F  )^]  P 
r V I r o 

and 

P_  = [1  - (F  P . 

t V j Q 

To  first  order  in  (F 

r 
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(2.17) 


p ^ 2(r  p 

r r o 

P,  ^ [1  - 2(r  )^]  P 

t ‘ ' r ^ O’ 

For  a single  surface  (i.e.,  ignoring  multiple  reflections  caused  by  a second  surface),  the  reflected  and 
transmitted  powers  are  obtained  by  inspection 


P = (r  )^  P 
r r 0 

p,  = (1  - (r  )^]  P . 

t r 0 


(2.18) 


v2  . 


Even  though  the  pairs  of  eqs  (2.17)  and  (2.18)  differ  slightly  in  form,  (F^)  is  so  small  that  the  effect 
of  a second  surface  on  P^  is  generally  negligible;  and,  in  both  cases,  P^  is  so  slightly  different  from  P^ 
that,  again,  we  ignore  the  effect  of  a second  surface.  Therefore,  we  consider  only  a single  reflecting/ 
transmitting  surface  for  each  material  in  a building  wall.  Any  error  incurred  by  this  assumption  will  be 
covered  by  the  100%  uncertainty  we  have  assigned  to  the  reflection  coefficients  for  dielectric  construc- 
tion materials. 


2.5  Reflection  Coefficient  and  Attenuation  Data  for  Selected  Building  Materials 

The  data  in  the  following  fourteen  tables  has  been  entered  into  the  data  file  MATTER  and  is  ready  for 
use  in  the  building  attenuation  computations  performed  by  the  program  MASTER.  We  preface  the  tables  with 
these  comments: 

• The  null  material  (MOl)  must  be  used  as  the  "material"  of  an  open  doorway  or  an  open,  unscreened 
window.  As  a formality  whenever  material  MOl  is  needed,  the  user  must  enter  into  the  data  file 
HOLES  a material  thickness  T of  1 cm. 

• Dry  wall  (wall  board,  sheet  rock)  is  mainly  plaster  of  Paris  (material  M03). 

• The  word  "moist"  (materials  M02,  M03,  M06,  M07)  does  not  imply  "soft",  "fresh",  or  "uncured", 
but  only  that  material  samples  measured  after  24  hours  in  a saturated  atmosphere  (as  opposed  to 
samples  baked  dry)  had  electrical  properties  more  similar  to  the  same  materials  in  field  condi- 
tions . 

• "Clay  brick"  (material  M06)  refers  to  the  brick  commonly  used  in  homes  and  buildings. 

• All  common  lumber  and  plywood  have  a very  low  reflection  coefficient  and  attenuation  (dB/cm). 

Therefore,  the  material  data  tables  contain  only  Douglas  fir  and  fir  plywood  as  representative 
types  to  be  used  for  any  wood  or  plywood  the  user  may  encounter  as  building  materials. 

• Because  the  attenuation  by  a metal  screen  (materials  M09,  MIO,  Mil)  is  actually  an  insertion 

loss  given  in  dB  instead  of  dB/cm,  the  mesh  thickness  is  not  required.  However,  as  a formality 

to  satisfy  the  computation  program  MASTER,  the  user  must  enter  into  the  data  file  BxxxxxT  a mesh 

thickness  T of  1 cm. 

• The  assigned  uncertainties  are  in  the  transmitted  and  reflected  powers,  and  must  not  be  applied 
to  the  attenuation  in  dB/cm. 
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Table  2.1:  Null  Material  (Mat'l.  No.  MOl)  (Thickness  T = 1 cm) 


Frequency 


10 

10 

10 

10 

10 

10 

10 


4 

5 

6 

7 

8 

9 

10 


(Hz) 


Attenuation  (dB/cm) 
0 
0 
0 
0 
0 
0 
0 


Power  reflection  coefficient 
0 
0 
0 
0 
0 
0 
0 


Material:  Fictitious;  a formality,  required  by  the  program  MASTER,  used 

to  represent  the  "material"  of  passageways,  open  doorways, 
and  open,  unscreened  windows. 


Table  2.2:  Moist  Mortar  (Mat'l.  No.  M02) 

Frequency  (Hz)  Attenuation  (dB/cm)  Power  reflection  coefficient 


10^ 

X 

<N 

CM 

10-6 

0.23 

10^ 

7.54  X 

O 

1 

ON 

0.17 

10^ 

3.55  X 

10-6 

0.16 

10^ 

X 

o 

10-^ 

0.13 

10« 

1.89  X 

1— » 
O 

1 

0.10 

10^ 

1.12  X 

10-^ 

0.055 

10^° 

0.13* 

0 . 03* 

Material: 

Moist  mortar; 

6.5  gal.  H.,0/94  lb.  sack  of 

cement; 

Portland 

, cement-aggregate  ratio:  1/3. 

Data  Source: 

Brennan 

[4]. 

Assigned  Uncertainty: 

Attenuation, 

10%;  reflection  coefficient. 

100%. 

*Extrapolated . 

Table  2.3:  Plaster  of  Paris  (Mat'l.  No.  M03) 


Frequency  (Hz) 

Attenuation  (dB/cm) 

Power  reflection 

coefficient 

10^^ 

2.98 

X 

o 

1 

0.063 

10^ 

4.41 

X 

10-^ 

0.059 

106 

1.50 

X 

10-6 

0.084 

10^ 

2.58 

X 

10-6 

0.076 

10« 

4.84 

X 

10-^ 

0.063 

10^ 

7.6 

X 

1 

O 

0.007 

O 

o 

7.6 

X 

lO"^* 

0.007* 

Material : 

Moist  plaster  of 

Paris  (main  component  of 

dry  wall) . 

Data  Source: 

Assigned  Uncertainty: 

Brennan  [4] . 
Attenuation,  10%; 

reflection  coefficient. 

100%. 

“'Extrapolated. 
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Table  2.4:  Douglas  Fir  (Mat'l.  No.  M04) 


Frequency  (Hz) 

Attenuation  (dB/cm) 

Power  reflection  coefficient 

10^ 

4.28  X 10"^ 

0.047 

10^ 

2.59  X lo"^ 

0.041 

10^ 

4.35  X io‘^ 

0.063 

10^ 

1.10  X lo"^ 

0.050 

io8 

1.98  X lo"^ 

0.025 

10^ 

<N 

O 

X 

o 

CM 

0.019 

lO^O 

0 . 22* 

0.014* 

Material : 

Douglas  fir. 

Data  Source: 

Brennan  [4] . 

Assigned  Uncertainty:  Attenuation,  10%; 

reflection 

coefficient,  100%. 

*Extrapolated. 

Table  2.5:  Fir  Plywood 

(Mat'l.  No. 

M05) 

Frequency  (Hz) 

Attenuation  (dB/cm) 

Power 

reflection  coefficient 

10^ 

1.15  X lo"^ 

0.068 

10^ 

6.77  X lo"^ 

0.048 

10^ 

8.31  X io‘^ 

0.074 

10^ 

1.24  X io“^ 

0.036 

10^ 

2.15  X 10"^ 

0.014 

10^ 

2.6  X lo'^ 

0.013 

o 

o 

0 . 30* 

0.010* 

Material: 

Data  Source: 

Assigned  Uncertainty: 


Fir  plywood. 

Brennan  [4] . 

Attenuation,  10%;  reflection  coefficient,  100%. 


*Extrapolated. 


Table  2.6:  Clay  Brick  (Mat'l.  No.  M06) 


Frequency  (Hz) 

Attenuation  (dB/cm) 

Power  reflection  coefficient 

lo"^ 

2.20 

X 

10-' 

0.13 

10^ 

1.02 

X 

io“^ 

0.072 

10^ 

1.4 

X 

-U 

10  * 

0.051* 

10^ 

2.5 

X 

10‘3* 

0.029* 

o 

OO 

5.72 

X 

CO 

1 

o 

0.014 

10^ 

5.72 

X 

lO”^ 

0.014 

O 

o 

5.7 

X 

10"3* 

0.014* 

Material:  Moist  clay  brick. 

Data  Source:  Brennan  [4]. 

Assigned  Uncertainty:  Attenuation,  10%;  reflection  coefficient,  100%. 

*Interpolated  or  extrapolated. 
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Table  2.7:  Cinder  Block  (Mat'l.  No.  M07) 


Frequency  (Hz) 


Attenuation  (dB/cm) 


Power  reflection  coefficient 


10^ 

1.74  X lo"^ 

0.17 

10^ 

8.30  X lo“^ 

0.14 

10^ 

3.85  X lo"^ 

0.13 

10^ 

2.82  X 10“'^ 

0.055 

10« 

5.71  X 10"^ 

0.013 

10^ 

5.71  X lo"^ 

0.013 

10^® 

0.57* 

0.013* 

Material : 

Data  Source: 

Assigned  Uncertainty: 


Moist  cinder  block  (Featherlite) . 

Brennan  [4] . 

Attenuation,  10%;  reflection  coefficient,  100%. 


^Extrapolated. 


Frequency  (Hz) 

Table  2.8:  Glass  (Mat'l. 
Attenuation  (dB/cm) 

No.  MOB) 

Power  reflection  coefficient 

10^ 

1.36  X io“® 

0.20 

10^ 

2.28  X lo"^ 

0.18 

10^ 

2.88  X 10“^ 

0.19 

10^ 

3.95  X 10"^ 

0.19 

10« 

g 

o 

X 

o 

o 

0.15 

10^ 

5.04  X io“® 

0.082 

lolO 

7.1  X lo"^* 

0.015* 

Material : 

Glass  (t3rpe  not  specified).  We  assume  "window  glass' 

Data  Source: 

Assigned  Uncertainty: 

because  the  Brennan  report  concerns  only  building 
materials . 

Brennan  [4] . 

: Attenuation,  10%;  reflection  coefficient,  100%. 

*Extrapolated. 

Table  2.9:  Steel  Mesh  (Mat'l.  No.  M09) 

(Thickness  T = 1 cm) 

Frequency  (Hz) 

Attenuation  (dB/cm) 

Power  reflection  coefficient 

10^ 

141.0* 

1.0 

10^ 

132.0* 

1.0 

10^ 

114.0 

1.0 

10^ 

94.1 

1.0 

10® 

44.0* 

1.0 

10^ 

54.1 

1.0 

lo'o 

34.0* 

1.0 

Material:  Galvanized  steel  mesh  (24  x 24). 

Data  Source:  Jakubec  and  Ohta  [9]. 

Assigned  Uncertainty:  Attenuation,  1%;  reflection  coefficient,  1%. 

*lnterpolated  or  extrapolated. 
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Table  2.10:  Copper  Mesh  (Mat'l.  No.  MIO)  (Thickness  T = 1 cm) 


Attenuation  (dB/cm) 


Power  reflection  coefficient 


10^ 

106.0* 

1.0 

10^ 

110.0* 

1.0 

10^ 

104.2 

1.0 

10^ 

88.0 

1.0 

10® 

68 . 0* 

1.0 

10^ 

48.4 

1.0 

lo'O 

28 . 0* 

1.0 

Material : 

Copper  mesh  (20  x 20). 

Data  Source: 

Jakubec  and  Ohta  [9]. 

Assigned  Uncertainty: 

Attenuation,  1%;  reflection 

coefficient,  1%. 

*Interpolated 

or  extrapolated. 

Table  2.11: 

Reinforcing  Bar  Mesh  (Mat'l.  No. 

Mil) 

(Thickness  T = 1 cm) 

Frequency  (Hz) 

Attenuation  (dB/cm) 

Power  reflection  coefficient 

10^ 

1000.0* 

1.0 

10^ 

1000.0* 

1.0 

10^ 

1000.0* 

1.0 

10^ 

1000.0* 

1.0 

10® 

12.2 

0.94 

10^ 

0.22 

0.05 

lolo 

0 

0 

Material : 

Reinforcing  bar  square 

mesh; 

; 35.6  cm  on  centers;  bar 

diameter  =4.3  cm. 

Data  Source: 

Hill  and  Wait  [12];  MacFarlane  [11]. 

Assigned  Uncertainty: 

Attenuation,  1%;  reflection 

coefficient,  1%. 

*To  represent 

infinite  attenuation  as  computed  from  unity  power  reflection 

coefficient. 

Table  2.12:  Iron  Sheet  (Mat'l 

. No. 

M12) 

Frequency  (Hz) 

Attenuation  (dB/cm) 

Power  reflection  coefficient 

10^ 

+3 

1.71  X 10 

1.0 

10^ 

5.42  X lo"^® 

1.0 

10^ 

1.43  X lo'^^ 

1.0 

10^ 

3.83  X lo'^^ 

1.0 

10® 

5.42  X lo'^'^ 

1.0 

10^ 

1.21  X lo"^® 

1.0 

o 

O 

5.42  X lo"^^ 

1.0 

Material : 

Iron  sheet. 

Data  Source: 

Denny  [7];  Campi  [8]. 

Assigned  Uncertainty: 

Attenuation,  1%;  reflection 

coefficient,  1%. 
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Table  2.13:  Aluminum  Sheet  (Mat'l.  No.  M13) 


Frequency  (Hz)  Attenuation  (dB/cm)  Power  reflection  coefficient 


10^ 

1.03 

X 

10"2 

1.0 

10^ 

3.24 

X 

10"2 

1.0 

10^ 

1.03 

X 

lO"^^ 

1.0 

10^ 

3.24 

X 

lo'^^ 

1.0 

10« 

1.03 

X 

lO*""^ 

1.0 

10^ 

3.24 

X 

lO-"^ 

1.0 

iqIO 

1.03 

X 

lo"^^ 

1.0 

Material : 

Data  Source: 

Assigned  Uncertainty: 


Aluminum  sheet. 

Denny  [7];  Campi  [8]. 

Attenuation,  1%;  reflection  coefficient,  l7o. 


Table  2.14:  Copper  Sheet  (Mat'l.  No.  M14) 

Frequency  (Hz)  Attenuation  (dB/cm)  Power  reflection  coefficient 


10^ 

1.31 

X 

10"2 

1.0 

10^ 

4. 16 

X 

10-^2 

1.0 

10^ 

1.31 

X 

lO'^® 

1.0 

10^ 

4. 16 

X 

lO"^® 

1.0 

10® 

1.31 

X 

10^"^ 

1.0 

10^ 

4 . 16 

X 

lO'^'^ 

1.0 

o 

o 

1.31 

X 

lo"^® 

1.0 

Material:  Copper  sheet. 

Data  Source:  Denny  [7];  Campi  [8]. 

Assigned  Uncertainty:  Attenuation,  1%;  reflection  coefficient,  1%. 
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3.  CALCULATION  FOR  BUILDING  SHIELDING  EFFECTIVENESS  --  THEORY 


3 . 1 Introduction 

This  chapter  discusses  the  theoretical  basis  for  the  calculation  of  building  shielding  effectiveness. 
After  this  introduction,  there  are  four  sections  which  consider  a definition  of  the  problem,  the  input 
data  that  will  be  used  in  the  calculation,  the  actual  mathematical  approach  used  to  calculate  building 
shielding  effectiveness,  and  window  and  door  resonances. 

3.2  Definition  of  Problem 

The  purpose  of  this  project  is  to  calculate  how  well  a building  shields  from  external  electromagnetic 
interference.  Automated  on  a computer,  this  calculation  is  to  provide  a worst  case  estimate  of  the  elec- 
tromagnetic power  level  appearing  in  a room  of  a building  given  the  physical  construction  and  dimensions 
of  the  building  and  given  a known  external  incident  field  strength.  The  estimate  must  be  useful  over  a 
wide  frequency  range  (10  kHz  - 10  GHz)  and  must  be  general  enough  so  that  it  can  be  used  effectively  on 
several  hundred  differently  constructed  buildings. 

3.3  Input  Data  Available 

In  any  given  calculation  of  electromagnetic  shielding  effectiveness,  it  is  always  desirable  to  have 
sufficient,  high  quality  data  to  make  the  calculation  yield  a precision  result.  For  example,  the  best 
data  possible  would  be  to  actually  measure  a given  building  for  electromagnetic  shielding  effectiveness 
using  external  antennas  to  launch  a known  field  and  calibrated  antennas  to  measure  the  field  inside  of  the 
building.  The  calculation  would  then  be  trivial  — the  ratio  of  the  launched  field  versus  the  measured 
internal  field  would  be  calculated  directly.  In  fact  such  measurements  have  been  performed  and  have 
yielded  excellent  results.  Such  field  measurements  made  during  this  project  are  detailed  in  Chapter  6 of 
this  report. 

Direct  measurements  of  electromagnetic  shielding  effectiveness,  although  highly  effective  in  charac- 
terizing a building,  have  the  disadvantage  of  being  time  consuming  and  expensive.  A typical  field  meas- 
urement of  one  building  at  one  site  can  take  three  or  four  engineers  from  three  to  five  days  to  complete. 
When  three  to  five  hundred  buildings  are  contemplated,  it  clearly  becomes  difficult  to  obtain  actual  field 
data  in  an  efficient  manner.  Another  approach  is  to  take  "less  expensive"  data  that  can  be  used  in  a 
model  that  will  give  an  estimate  of  the  shielding  effectiveness.  This  estimate  may  not  be  as  accurate  a.s 
actual  field  data,  but  it  may  give  sufficient  accuracy  to  make  a cost  effective  analysis  of  a building. 

This  section  describes  the  data  that  will  be  used  in  the  estimation  of  building  measurements. 
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For  a particular  calculation  for  a given  building,  the  input  data  is  restricted  to  the  actual  physi- 
cal construction  details  of  the  building.  The  input  data  include:  1)  building  construction  materials;  2) 
the  dimensions  of  the  building;  and,  3)  the  construction  practices  involved  in  erecting  the  building. 

These  three  categories  of  data  are  to  be  obtained  either  from  building  drawings  which  were  used  in  the 
original  construction  and  which  have  been  properly  updated  with  modifications,  or  by  actual  physical 
measurements  on  the  building  itself.  Although  it  will  be  less  accurate  than  direct  EMI  measurements,  the 
estimate  of  EM  shielding  effectiveness  based  on  the  physical  construction  of  the  building  should  be  suf- 
ficiently accurate  to  determine  the  suitability  of  most  buildings  for  electromagnetic  shielding.  In  the 
few  cases  where  the  calculated  estimate  is  perhaps  ambiguous,  actual  EMI  measurements  could  be  performed. 

A test  plan  for  field  measurements  of  EMI  for  these  marginal  cases  is  presented  in  the  appendix.  Details 
and  methods  for  gathering  the  actual  physical  data  and  putting  it  into  a form  usable  in  the  present  com- 
puter model  will  be  presented  in  Chapter  5,  "User's  guide  to  the  computer  programs." 

3.4  Approach 

To  estimate  the  electromagnetic  shielding  ability  of  a building,  the  following  approach  is  taken. 

The  energy  entering  the  building  from  external  sources  is  calculated  for  each  room  by  considering  the 
direct  penetration  through  all  the  walls,  windows  and  doors.  The  energy  in  each  room  can  then  go  to  the 
other  rooms  through  internal  walls  and  doors,  as  well  as  going  back  outside.  As  the  energy  continues  to 
flow  through  each  room,  the  power  in  each  room  reaches  a steady  state  condition  corresponding  to  a balance 

between  the  energy  flowing  in  and  out.  To  calculate  the  steady  state  power  level,  it  is  necessary  to 

first  consider  a model  that  will  describe  the  flow  of  the  electromagnetic  energy  through  the  building. 

The  assumptions  in  this  model  listed  in  figure  3.1,  and  graphically  shown  in  figure  3.2,  must  also  be 
considered . 

The  first  assumption  is  that  the  input  electromagnetic  radiation  will  consist  of  plane  waves  with 
normal  incidence  on  a particular  external  wall.  The  calculation  will  be  repeated  five  times  corresponding 
to  the  four  horizontal  incidence  directions  (i.e..  North,  South,  East  and  West)  and  the  one  vertical  di- 
rection (i.e.,  from  above).  The  sixth  direction,  from  below  or  through  the  ground  will  be  ignored. 

The  first  assumption  is  used  to  calculate  the  power  entering  a room  through  an  external  wall  from  the 

3 

outside.  If  the  energy  density  of  the  incident  field  is  represented  by  P with  units  of  joules/m  , the 

energy,  Ejj^,  entering  a room  in  one  second  will  be 

Ejjj  = tPcA  (3.1) 

where  t is  the  transmission  coefficient/unit  length  of  the  external  wall  and  c is  the  speed  of  the  elec- 
tromagnetic radiation  (the  speed  of  light).  The  term  A represents  the  area  of  the  external  wall.  If  the 
room  has  a door  in  the  wall,  eq  (3.1)  becomes 
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tjPcAj  + t2PcA2 


(3.2) 


= 


where  ^nd  A2  represent  the  transmission  coefficient  and  area  of  the  door. 

The  second  assumption  is  that  there  will  be  no  refraction  by  the  building  of  the  incident  plane  wave, 
and  the  incoming  energy  will  only  enter  those  walls  which  are  normal  to  the  incoming  radiation.  This 
effect  can  also  be  considered  a shadowing  effect. 

The  third  assumption  deals  with  multiple  layers  on  a wall.  It  states  that  the  composite  transmission 
coefficient  of  a multi-layered  wall  will  be  represented  as  the  product  of  the  individual  transmission 
coefficients  of  the  layers  or 


t = nt.  (3.3) 

composite  1 

where  the  t^'s  represent  the  transmission  coefficient  of  the  layers.  This  is  really  a simplification  that 
ignores  internal  reflections  in  the  walls  and  the  related  interference  effects. 

The  fourth  assumption  considers  how  the  energy  in  a room  scatters  and  flows  to  the  other  rooms.  This 
assumption  states  that  the  energy  in  a room  will  be  isotropically  scattered  in  all  directions.  Hence,  in 
a cubic  room  where  the  four  walls,  the  floors  and  ceilings  all  have  the  same  area,  one  sixth  of  the  room's 
energy  would  hit  each  of  the  six  surfaces  equally. 

To  find  the  transmission  of  energy  from  one  room  to  another,  consider  figure  3.3,  a building  with  two 

3 

rooms.  The  first  room  has  an  energy  density  N,  (J/m  ).  From  assumption  four,  this  energy  is  iso- 
tropically scattered  in  all  directions  equally.  The  fraction,  F,  of  the  energy  scattered  against  the 
internal  wall  will  be 


F = 


(3.4) 


1 , total 

where  A^  is  the  internal  wall  area,  and  A^  total  total  area  of  the  walls,  floor,  and  ceiling  in 

room  1.  The  energy  that  is  transmitted  per  second  from  room  1 to  room  2 will  be 


E,  = t N,  c F A 
1,2  1 w 


(3.5) 


where  the  subscripts  on  E represent  flow  from  room  1 to  room  2.  Substituting  for  F yields 

A.,2 

E,  „ = t N,  c 


1,2  • 

Note  that  the  energy  flowing  from  room  2 to  room  1 will  be 

. 2 


(3.6) 


^2,1  ^ ^2  A 


(3.7) 


2,t 


which  differs  from  eq  (3.6)  because  the  room  2 energy  density,  N2,  is  different  and  the  total  area  of 
room  2,  A2  is  different.  Using  eqs  (3.1)  and  (3.6)  the  energy  transmitted  between  the  outside  to  th- 
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rooms,  and  from  room  to  room,  can  be  described.  We  must  now  consider  absorption  and  reflection  for  the 
walls,  which  brings  us  to  the  fifth  assumption. 

The  fifth  assumption  states  that  wall  reflections  will  be  ignored  unless  the  frequency  of  the 
radiation  is  near  a resonance  of  the  room.  Outside  of  resonance,  any  radiation  hitting  a wall  that  is  not 
transmitted  will  be  absorbed  or 

D = 1 - t (3.8) 


where  D is  the  absorption  coefficient  and  t is  the  transmission  coefficient.  When  the  frequency  is  near  a 
room  resonance  then  reflections  will  be  accounted  for  and 

D = 1 - t - r (3.9) 


where  r now  represents  the  reflection  coefficient. 

The  frequency  range  of  a room  resonance  will  be  between  and  where 


and 


1 

'2 


high 


3 + / 3 y + / 3 


where  A,  B,  and  C represent  the  three  dimensions  of  the  room  with  B and  C being  the  longest.  Experience 
indicates  that  modes  above  3,  3,  3 do  not  contribute  significantly  to  resonance  fields  in  a room. 
Therefore,  these  higher  order  modes  are  ignored  in  this  model. 

Note  that  in  resonance,  eq  (3.9)  reduces  the  absorption  coefficient  and  hence  reduces  the  effective 
energy  loss  from  the  room.  This  is  equivalent  to  reflecting  it  back  into  the  room. 

The  energy  losses  in  a room  can  now  be  found  by  replacing  t in  eq  (3.7)  with  D from  either  eq  (3.8) 
or  (3.9)  and  obtaining 


L 


1,2 


D N, 


(3.10) 


where  L represents  the  energy  lost  from  the  room. 

The  sixth  assumption  states  that  in  a calculation  of  the  steady  state  energy  distribution  within  a 
structure,  the  E or  H field  is  computed  by  assuming  free  space  impedance.  To  calculate  the  steady  state 
energy  in  a room,  we  first  write  down  an  equation  which  represents  the  change  in  energy  with  respect  to 
time  or 


^^1^1  = G - L (3.11) 

dt 
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where  Vj  is  the  volume  of  the  room  and  G represents  the  sum  of  all  the  energy  gains  into  the  room  as 
represented  by  either  eqs  (3.2),  (3.6)  or  (3.7).  Note  that  a room  can  gain  energy  from  the  outside 
(eq  (3.2))  and  from  other  rooms  (eqs  (3.6)  or  (3.7)).  In  eq  (3.11),  L represents  the  energy  lost  from  a 
room  and  is  taken  from  eq  (3.6)  for  energy  transmitted  out  or  eq  (3.10)  for  energy  absorbed  in  a wall. 

Note  that  for  M rooms,  there  will  be  M eq  (3.11)'s. 

For  the  steady  state  condition  eq  (3.11)  will  equal  zero.  Hence  there  will  be  M eq  (3.11)'s  equal  to 
zero.  Since  the  M eq  (3.11)'s  have  only  M unknowns  (the  M energy  levels  in  each  room)  there  will  be  a 
unique  solution  which  gives  the  M energy  levels  in  the  rooms. 


3.5  Input  Resonances 

Room  resonances  have  already  been  considered  by  adding  the  reflection  coefficients  of  a wall  in 
eq  (3.9).  An  additional  input  resonance  is  also  considered  for  windows  or  doors  in  the  following  manner. 
If  a window  or  door  has  a metal  frame,  then  the  transmission  coefficient  for  the  window  is  increased  by  20 
dB  if  the  incoming  frequency  is  near  a window  resonance.  The  frequency  range  for  a window  resonance 
will  be  defined  as  lying  between  and  ^high 


F = — 
low  2B 


F = - 
^high  2 

where  A and  B are  the  smallest  and  largest  dimensions  of  the  windows.  Note  that  resonances  above  mode  3,3 
are  ignored. 
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1.  Plane  wave  incident  on  surface(s)  of  structure.  Use 
attenuation  of  wall  material(s)  to  calculate  transmission. 

2.  Ignore  external  refraction  by  building. 

3.  Disregard  multiple  internal  reflections  within  wall(s). 

4.  Energy  reaching  inside  of  structure  is  scattered 
isotropically.  Energy  leaves  structure  through  all 
available  surfaces. 

5.  Reflections  within  room  from  walls,  celling,  etc.,  are 
only  considered  if  frequency  is  near  room  resonance(s). 
Only  first  three  resonant  modes  are  considered. 

Input  coupling  resonances  are  also  considered  for 
metal  door  and  window  frames  by  increasing 
transmission  by  20  dB  near  resonant  frequency. 

6.  Steady  state  energy  distribution  within  structure 
allows  E or  H field  to  be  computed  (free  space 
impedance  assumed). 


FIGURE  3.1  ASSUMPTIONS  USED  IN  MODEL. 


I 


I 

I 


FIGURE  3.2  ENERGY  FLOW  ANALYSIS. 
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E2.I 

ROOM  01 

ROOM  02 

Ni 

N2 

Aw=AREA  of  wall 


FIGURE  3.3  ENERGY  FLOW  BETWEEN  TWO  ROOMS. 
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4.  COMPUTER  PROGRAM  DESCRIPTIONS 


4 . 1 Introduction 

This  chapter  provides  a description  of  the  computer  programs  used  in  the  calculation  of  electro- 
magnetic shielding  effectiveness  of  buildings.  The  presentation  is  aimed  at  the  programmer  level.  The 
intention  is  to  provide  information  about  the  programming  methods  used  in  the  present  calculations.  In- 
formation on  how  to  use  the  programs  is  provided  in  Chapter  5,  entitled,  "User's  guide  to  each  of  the 
programs."  This  chapter,  besides  the  introduction,  has  four  additional  sections  which  describe  the  field 
calculation  program,  the  data  entry  programs,  the  data  structures  used  in  the  programs,  and,  finally,  a 
more  detailed  description  of  the  programs  and  their  subroutines  listed  in  alphabetical  order.  This  last 
section  also  highlights  those  variables  which  are  important  to  the  understanding  of  the  programs. 

The  project's  purpose  is  to  calculate  the  maximum  electromagnetic  field  possible  in  each  room  of  a 
building  from  a plane  wave  impinging  directly  upon  the  walls  of  the  building  given  the  dimensions  of  the 
building  and  the  materials  used  in  its  construction.  The  program  accesses  permanent  data  files  which 
describe  the  dimensions  and  material  of  each  layer  of  each  wall,  door,  and  window  of  the  building.  These 
data  files  are  created  for  each  building  using  separate  programs.  The  program  also  accesses  a previously 
stored  data  file  which  contains  the  attenuation  and  reflection  coefficients  of  different  construction 
materials.  This  data  is  then  used  to  calculate  a transmission  coefficient  and  an  absorption  coefficient 
for  each  wall  considering  the  properties  of  each  layer  and  each  opening.  Using  these  coefficients  an 
energy  flow  into  each  room  from  the  outside  and  from  the  other  rooms  is  calculated.  The  energy  flowing 
back  out  of  the  building  is  also  then  calculated.  A steady  state  energy  balance  is  then  assumed  for  all 
the  rooms,  and  from  this  steady  state  assumption,  the  energy  level  in  each  room  is  calculated. 

4.2  General  Description  of  the  Field  Calculation  Program 

A procedure  file  FIELD  gets  the  main  program  from  mass  storage  and  runs  it.  The  main  program  MASTER 
sets  up  the  common  blocks  and  then  calls  each  of  the  subroutines.  Five  subroutines  (LMATTER,  LFREQ, 

LWALL,  LTYPE,  and  LHOLE)  load  data  from  permanent  storage  into  arrays  which  are  accessed  by  the  program 
when  the  data  is  needed  for  computation.  The  subroutine  LTDB  calculates  the  attenuation  and  area  of  each 
type  opening,  layer  by  layer,  and  loads  it  into  the  TDB  array. 

The  CFACTOR  subroutine  calculates  transmission  factors  of  each  wall  and  loads  them  into  the  ROOM 
array.  These  transmission  factors  determine  the  transmission  between  each  room  and  its  adjacent  volume, 
which  may  be  another  room  or  the  exterior  of  the  building.  The  calculation  is  performed  for  each  materia! 
layer  of  each  wall  and  of  each  opening  in  the  wall.  Note:  in  this  discussion  "wall"  also  means  floor  .ind 
ceiling.  These  calculations  are  done  sequentially  and  accumulated  as  the  data  for  each  layer  of  ea- h 
opening  is  accessed  in  the  data  files. 
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The  DFACTOR  subroutine  calculates  the  absorption  factor  of  each  wall  and  loads  them  into  the  DDABS 
array.  In  this  calculation  the  absorption  is  taken  as  one  minus  the  transmission  and  minus  the  reflec- 
tion. The  reflection  coefficient  is  included  if  a resonance  condition  is  met. 

The  subroutine  ECALC  is  used  to  calculate  the  steady  state  energy  in  the  rooms.  It  starts  by  calling 
the  subroutine  SETUP  which  takes  the  transmission  coefficients  from  the  ROOM  arrays  and  combines  them  with 
the  absorption  coefficients  in  the  DDABS  array  to  produce  the  proper  relationships  for  energy  flow  between 
the  rooms  and  the  outside.  These  linear  relationships  are  put  into  the  THAT  array.  The  subroutine  ECALC 
then  calculates  the  steady  state  energy  balance  in  the  rooms  using  the  subroutine  DETERM.  The  subroutines 
RESOND  and  RESONW  calculate  resonance  conditions  for  apertures  and  rooms. 

Several  subroutines  with  a "P"  prefix  print  results  or  file  contents.  For  example,  PHOLE,  PTYPE, 
PWALL  print  the  data  contained  in  the  data  files  and  the  corresponding  arrays. 

4.3  General  Description  of  the  Data  Entry  Programs 

There  are  five  data  entry  programs:  three  to  store  data  describing  buildings,  one  to  store 
frequencies,  and  one  to  store  properties  of  construction.  The  three  which  store  the  building  data  are 
SWALLS,  STYPES,  and  SHOLES;  the  material  properties  are  stored  by  SMATDB.  The  frequencies  are  stored 
using  SFREQ.  These  are  source  code  files;  the  user  will  only  see  the  equivalent  procedure  files  HSTORE, 
WSTORE,  TSTORE,  FSTORE  and  MSTORE  which  call  and  run  the  compiled  binary  equivalents  of  these  source 
files . 

All  three  building  description  programs  use  the  same  interactive  format.  Each  asks  the  user  for  a 
building  identifier  which  can  be  as  many  as  five  characters  long.  That  building  identifier  is  used  to 
create  the  names  for  the  permanent  data  files  needed  for  each  building.  For  example,  if  the  building 
identifier  were  "A125"  then  three  permanent  files  would  be  named  and  created:  "BA125T",  "BA125W", 

"BA125F",  and  "BA125H".  The  suffixes  "T",  "W",  "F",  and  "H"  refer  to  "Type"  data,  "Wall"  data, 

"Frequency"  data  and  "Hole"  data,  respectively. 

The  material  data  storage  program,  also  interactive,  stores  attenuation  and  reflection  coefficient 
data  for  different  frequencies  in  a permanent  file  called  MATTER.  This  program  will  only  be  used  for 
adding  new  construction  materials  to  the  material  data  base. 

4.4  Data  Structures  Used  in  the  Programs 

Arrays  and  Variables: 

The  following  gives  a brief  description  of  the  variables  used  in  the  common  blocks. 

Hole  Variables 

HMAX:  maximum  size  of  hole  array.  Initially  set  at  35. 
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HOLE  (1-HMAX,  1-4):  Array  containing  room  and  aperture  ID. 

HOLE  (x,l):  "Direction"  part  of  room  identification. 

HOLE  (x,2):  "From  room"  part  of  room  identification. 

HOLE  (x,3):  "To  room"  part  of  room  identification. 

HOLE  (x,4):  "Aperture  ID". 

HTOT:  A numeric  variable  containing  the  total  number  of  lines  in  the  "hole"  data  file. 

HERR:  A numeric  variable  used  to  indicate  a file  handling  error  and  used  in  the  WARNING  and 
ERROR  subroutines  to  trigger  a message  to  the  operator. 

Type  Variables 

TMAX:  Maximum  size  of  TYPE  and  TDIM  arrays.  Initially  set  at  35. 

TYPE  (1-TMAX,  1-4):  Character  array  containing  dimensions  and  material  of  each  layer  of 
each  type  of  door  or  window. 

TYPE  (x,l):  Identification  of  type,  e.g.,  "WA"  meaning  window  "A"  and  "DB"  meaning  door  B. 
TYPE  (x,2):  Material  of  layer,  e.g.,  "M03"  meaning  Material  #3. 

TYPE  (x,3):  Material  of  the  frame,  e.g.,  "M05"  meaning  Material  #5. 

TDIM  (1-TMAX,  1-4):  Numeric  array  containing  dimensions  of  each  door  or  window.  Used  in 
parallel  with  TYPE  array. 

TDIM  (x,l):  Height  of  opening  in  meters. 

TDIM  (x,2):  Width  of  opening  in  meters. 

TDIM  (x,3):  Thickness  of  layer  in  centimeters. 

TDIM  (x,4):  Distance  of  opening  above  floor  in  meters. 

TDBl  (1-TMAX):  Character  array  containing  opening  identification.  Used  in  parallel  with 
TDB2  array. 

TDBl  (x) : Opening  identification,  e.g.,  "WA". 

TDB2  (1-TMAX,  1-2):  Numeric  array  containing  attenuation  and  area  of  opening.  Used  in 
parallel  with  TDBl  array. 

TDB2  (x,l):  Attenuation  of  opening. 

TDB2  (x,2):  Area  of  opening  in  square  meters. 

TTOT:  A numeric  variable  containing  the  number  of  lines  in  the  "Type"  data  files. 

TDBTOT:  A numeric  variable  representing  the  total  number  of  lines  in  the  TDBl  and  TDB2 
data  arrays. 

TERR:  A numeric  variable  used  to  indicate  an  error  and  used  in  the  WARNING  and  ERROR  sub- 
routines to  trigger  a message  to  the  operator. 
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Material  Variables 


MAT  (1-100):  Contains  material  identifiers  such  as  "M01",  "M02",  ..."M99". 

MATDESC  (1-100):  Contains  description  of  each  material.  (70  characters  each). 

MFREQ  (1-100,  1-7)  real  array:  Contains  7 frequencies  at  which  the  property  data 

exists . 

MATTEN  (1-100,  1-7):  Contains  7 attenuation  values  for  each  material. 

QA  (1-100):  Contains  a quality  factor  for  each  material. 

MRCOEF  (1-100,  1-7):  Contains  7 reflection  coefficients  for  each  material. 

QR  (1-100):  Contains  a reflection  coefficient  quality  factor  for  each  material. 

Room  Variables 

DDABS  (1-RMAX  + 6,  1-RMAX  + 6):  This  numeric  array  contains  the  absorption  coefficients  of 

the  walls  in  each  room. 

ENERGY  (1-RMAX):  This  numeric  array  contains  the  results  of  the  energy  balance  calculations 
and  contains  the  energy  in  each  room. 

POWER  (1-6):  This  numeric  array  contains  the  power  entering  the  building  from  each  of  the 
six  outside  directions:  North,  East,  South,  West,  Top,  Bottom. 

RAREA  (1-RMAX):  Array  containing  surface  area  of  each  room. 

RMAX:  This  numeric  variable  sets  the  maximum  number  of  rooms  that  the  program  can  handle. 
Initially  set  for  20  for  simplicity  of  the  display  subroutine  when  printing  on  80 
col  limn  paper. 

ROOM  (1-RMAX  + 6,  1-RMAX  + 6):  This  numeric  array  is  used  for  the  transmission  factors 

between  room  and  room,  and  between  room  and  the  outside 

world. 

TMAT  (1-RMAX  + 6,  1-RMAX  + 6):  This  numeric  array  is  the  matrix  that  contains  the  linear 

relationships  of  energy  flow  between  the  rooms.  It  is  a 
combination  of  information  from  the  ROOM  array  and  the  DDABS 
array,  and  is  created  using  the  subroutine  SETUP. 

Wall  Variables 

WMAX:  Maximum  size  of  wall  arrays.  Initially  set  to  75. 

WALL  (1-WMAX,  1-4):  Character  array  containing  wall  identifiers  and  material  identification. 
WALL  (x,l):  Direction — one  of  three  wall  identifiers. 

WALL  (x,2):  From  room — one  of  three  wall  identifiers. 

Wall  (x,3):  To  room — one  of  three  wall  identifiers. 

WDIM  (1-WMAX,  1-3):  Numeric  array  containing  wall  dimensions. 
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WDIM  (x,l):  Height  in  meters. 

WDIM  (x,2):  Width  in  meters. 

WDIM  (x,3):  Layer  thickness  in  centimeters. 

WTOT:  A numeric  variable  containing  the  number  of  lines  in  the  Wall  data  files. 

WERR:  A numeric  variable  used  to  indicate  a file  handling  error  and  used  in  the  WARNING  and 

ERROR  subroutines  to  trigger  a message  to  the  operator. 

Miscellaneous  Variables 

BLDG:  This  character  variable  contains  the  building  identifier.  It  is  combined  with  other 

strings  to  identify  the  various  data  files  associated  with  that  building. 

DREFL:  This  variable  contains  the  reflection  coefficient  for  a wall.  If  the  frequency  is 
not  near  a room  resonance,  DREFL  is  set  to  zero. 

DREFLW:  This  variable  is  used  to  calculate  window  input  resonances.  If  the  frequency  is 
near  a window  resonance  then  DREFLW  is  set  to  20  dB.  Otherwise,  DREFLW  is  zero. 
FMAX:  Maximum  number  of  frequency  values  in  FREQA  array.  Initially  set  at  50. 

FREQ:  Frequency  in  hertz. 

FREQA  (1-FMAX):  A numeric  array  containing  frequencies  for  calculations. 

AFLAG:  A number  between  0 and  100  which  determines  how  much  of  the  quality  factor  is  ap- 
plied to  the  attenuation  value. 

RFLAG:  A number  between  0 and  100  which  determines  how  much  of  the  quality  factor  is  ap- 
plied to  the  reflection  coefficient  value. 

Labeled  Common  Blocks: 

This  section  lists  variables  transmitted  by  each  labeled  common  block  along  with  the  subroutines 
using  the  block. 

INITILC:  BLDG 

Common  to  MASTER,  CFACTOR,  LHOLE,  LTDB,  LTYPE,  LWALL,  PROOM,  PPWR,  PTMAT,  DFACTOR,  PDDABS, 
PPWR2,  SPWR,  RESONW,  RESOND,  LFREQ 
INITILN:  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA  (FMAX),  FERR,  FTOT 

Common  to  MASTER,  CFACTOR,  LHOLE,  LTDB,  LTYPE,  LWALL,  PROOM,  PPWR,  RESOND,  RESONW,  PPWR2 , 
PDDABS,  PTMAT,  DFACTOR,  SPWR,  LFREQ 
HOLEC:  HOLE  (HMAX,  4) 

Common  to  MASTER,  CFACTOR,  LHOLE,  DFACTOR,  PHOLE 
HOLEN:  HTOT,  HERR 

Common  to  MASTER,  CFACTOR,  LHOLE,  DFACTOR,  PHOLE 


31 


MATC:  MAT  (MMAX) , MATDESC  (MMAX) 

Common  to  MASTER,  ATTEN,  LMATTER,  RCOEF,  RESONW 
MAT:  TMAT  (RMAX,  RMAX) , ENERGY  (RMAX) , POWER  (6),  FTIME,  SWR  (RMAX,  6),  IDIR 
Common  to  MASTER,  SETUP,  ECAIC,  PPWR,  PTMAT,  PPWR2,  SPWR,  PDDABS 
MATN:  MATTER  (MMAX,  7),  MRCOEF  (MMAX,  7),  QA  (MMAX),  QR  (MMAX),  MFREQ  (MMAX,  7),  MERR,  MTOT 
Common  to  MASTER,  ATTEN,  LMATTER,  RCOEF,  RESONW 
ROOMD:  DDABS  (RMAX  + 6,  RMAX  +6),  DREFL,  DREFLW 

Common  to  MASTER,  CFACTOR,  SETUP,  DFACTOR,  LDDABS,  IDDABS,  RESOND,  RESONW 
ROOMN:  ROOM  (RMAX  + 6,  RMAX  + 6),  NROOMS,  RAREA  (RMAX) 

Common  to  MASTER,  CFACTOR,  LRAREA,  LROOM,  PROOM,  SETUP,  ECALC,  PPWR,  PTMAT,  IDDABS, 
DFACTOR,  LDDABS,  PPWR2,  SPWR,  RESOND,  RESONW,  PDDABS 
TYPEC:  TYPE  (TMAX,3),  TDBl  (TMAX) 

Common  to  MASTER,  CFACTOR,  LTDB,  LTYPE,  PTDB,  PTYPE,  SRCHTDB,  DFACTOR,  RESOND 

TYPEN:  TDIM  (TMAX,  4),  TTOT,  TDB2  (TMAX,  2),  TDBTOT,  TERR 

Common  to  MASTER,  CFACTOR,  LTDB,  LTYPE,  PTDB,  PTYPE,  SRCHTDB,  DFACTOR,  RESOND 

WALLC:  WALL  (WMAX,  4) 

Common  to  MASTER,  CFACTOR,  LRAREA,  LWALL,  PWALL,  DFACTOR,  RESONW 
WALLN:  WDIM  (WMAX,  3),  WTOT,  WERR 

Common  to  MASTER,  CFACTOR,  LRAREA,  LWALL,  PWALL,  DFACTOR,  RESONW 


4.5  Description  of  Programs  and  Subroutines  Used  in  Field  Calculation  (Listed  Alphabetically) 

Important  variables  (not  including  those  passed  by  common  blocks)  are  listed  after  each  routine. 

Subroutines  with  arguments  are  listed  with  the  arguments  in  parentheses. 

‘-^FUNCTION  ATTEN  (ID,  FREQ,  AFLAC):  This  real  function  returns  the  material  attenuation  for  a specified 
frequency  and  for  a specified  quality.  It  obtains  the  attenuation  values  from  the  MATTEN  array  and 
interpolates  according  to  the  frequency. 

ID:  Material  identification  such  as  "M01". 

“SUBROUTINE  CFACTOR:  This  subroutine  calculates  the  attenuation  of  each  wall  and  each  opening  in  each 
wall,  layer  by  layer,  and  then  calculates  transmission  factors  for  each  wall. 

DREFLW:  This  value  is  20  dB  near  a window  frequency  resonance. 

WATTEN:  Wall  attenuation. 

OATTEN:  Opening  attenuation,  whether  the  opening  is  a door  or  window. 

LATTEN:  Layer  attenuation. 

MATTEN:  Material  attenuation. 
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MATT:  Material  identifier  such  as  "M01". 

ID:  Identifier  of  opening. 

WALL:  Wall  array  containing  Wall  identification  and  Material  identification. 

^FUNCTION  DETERM  (ARRAY,  NORDER):  This  real  function  calculates  the  determinant  of  a matrix. 

ARRAY  (1-RMAX  + 6,  1-RMAX  + 6):  This  real  array  represents  the  input  matrix.  It  is  des- 
troyed during  the  calculation. 

NORDER  This  real  variable  represents  the  order  of  the  input  matrix. 

"SUBROUTINE  DFACTOR:  This  subroutine  calculates  the  attenuation  of  each  wall  and  each  opening  in  each 
wall,  layer  by  layer,  and  then  calculates  the  absorption  factor  for  each  wall. 

DREFL:  Wall  reflection  coefficient. 

WATTEN:  Wall  attenuation. 

OATTEN:  Opening  attenuation,  whether  the  opening  is  a door  or  a window. 

LATTEN:  Layer  attenuation. 

MATTEN:  Material  attenuation. 

ID:  Identifier  of  opening. 

WALL:  Wall  array  containing  Wall  identification  and  Material  identification. 

^SUBROUTINE  ECALC:  This  subroutine  calculates  the  energy  balance  in  the  rooms.  It  calls  subroutines  SETUP 
and  DETERM. 

PVECTOR  (1-RMAX):  This  real  array  contains  the  values  representing  the  initial  power  levels 
injected  into  each  room  from  the  outside  field. 

^'SUBROUTINE  ERROR  (lERR):  This  subroutine  returns  an  error  message  when  called  with  an  error  number  as 
argument.  It  also  stops  the  program.  The  error  numbers  and  error  messages  are 
listed  below: 

lERR  MESSAGE 

1 Materials  data  base  is  empty 

2 Frequency  is  out  of  range 

3 This  material  is  not  in  data  base 

4 Denominator  is  zero 

5 File  handling  error 

"FUNCTION  GETLEN  (STRING) : This  integer  function  returns  the  number  of  characters  in  a character  string 

when  given  the  character  string  as  an  argument. 

^'SUBROUTINE  IDDABS:  This  subroutine  initializes  the  DDABS  array. 

^'SUBROUTINE  LDDABS:  This  subroutine  loads  the  DDABS  array. 
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“SUBROUTINE  LFREQ:  This  subroutine  loads  the  array  FREQA  from  the  permanent  file  "BxxxxxP",  where  "xxxxx 


represents  the  building  identifier. 

‘^SUBROUTINE  LHOLE:  This  subroutine  loads  the  material  data  base  from  permanent  storage  into  the  HOLE  array 
for  access  by  the  program. 

“SUBROUTINE  LRAREA:  This  subroutine  calculates  the  surface  area  of  each  room  and  inserts  it  into  the  RAREA 
array. 

“SUBROUTINE  LMATTER:  This  subroutine  loads  the  material  data  base  from  permanent  storage  into  arrays  for 
access  by  the  program. 

“SUBROUTINE  LROOM  (TS,  TS2,  FROM,  TO):  This  subroutine  loads  the  transmission  coefficients  TS  and  TS2  into 
the  appropriate  room  location  in  the  ROOM  array. 

''^SUBROUTINE  LTDB:  This  subroutine  calculates  the  attenuation  and  area  of  each  type  opening,  layer  by  layer 
and  loads  it  into  the  TDB  array  (T3^e  Data  Base). 

^'SUBROUTINE  LTYPE:  This  subroutine  loads  arrays  TYPE  and  TDIM  with  data  from  permanent  file  "BxxxxxT", 
where  "xxxxx"  is  the  building  identifier. 

“SUBROUTINE  LWALL:  This  subroutine  loads  arrays  WALL  and  WDIM  with  data  from  permanent  file  "BxxxxxW", 
where  "xxxxx"  is  the  building  identifier. 

“PROGRAM  MASTER:  This  program  is  the  control  section  which  calls  each  of  the  subroutines.  The  program 
reads  in  wall,  window  and  door  data;  calculates  transmission  coefficients  of  each  wall;  stores  the 
transmission  coefficients  in  the  ROOM  matrix;  and  calculates  the  maximum  field  in  each  room  on  a 
normalized  basis.  It  is  called  by  the  user  with  procedure  file  FIELD. 

^'SUBROUTINE  PDDABS:  This  subroutine  prints  the  ROOM  matrix. 

^SUBROUTINE  PTDB:  This  subroutine  prints  the  array  TDBl  and  TDB2  giving  the  area  and  attenuation  of  each 
door  and  window  type. 

“SUBROUTINE  PHOLE:  This  subroutine  prints  the  contents  of  the  HOLE  array  giving  the  wall  location  of  the 
doors  and  windows. 

“SUBROUTINE  PPWR:  This  subroutine  prints  the  contents  of  the  ENERGY  array  and  represents  the  energy  values 
in  the  rooms . 

^'SUBROUTINE  PPWR2:  A second  version  of  PPWR  which  allows  a more  efficient  format.  It  uses  the  output  from 
the  subroutine  SPWR  stored  in  the  array  SWR. 

’'^SUBROUTINE  PROOM:  This  subroutine  prints  the  ROOM  array  giving  the  transmission  factor  of  each  wall. 

’^‘'SUBROUTINE  PTMAT:  This  subroutine  prints  the  contents  of  the  TMAT  array.  It  can  be  used  for  debugging 
the  program. 
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*SUBROUTINE  PTYPE:  This  subroutine  prints  the  contents  of  the  arrays  TYPE  and  TDIM  giving  the  parameters 


of  each  door  and  window  type. 

*SUBROUTINE  PWALL:  This  subroutine  prints  the  contents  of  the  WALL  and  WDIM  arrays. 

*SUBROUTINE  RESOND  (ID):  This  subroutine  calculates  the  range  of  frequencies  that  correspond  to  a 
resonance  condition  for  a window  or  door  with  a metal  frame.  If  the  frequency  of  the  incoming 
radiation  is  in  the  range  of  the  resonance  then  DREFLW  is  set  to  20  dB.  This  is  used  in  the  CFACTOR 
subroutine  to  increase  the  transmission  through  a window  by  20  dB  if  resonance  occurs. 

DREFLW:  This  is  the  return  variable.  (Used  in  common  block  ROOMD.) 

FLOW:  This  is  the  lower  frequency  bound  for  resonance. 

FHIGH:  This  is  the  upper  frequency  bound  for  resonance. 

ID:  This  is  the  identification  label  for  the  window. 

^SUBROUTINE  RESONW  (FROM,  MATID) : This  subroutine  calculates  the  frequency  range  that  corresponds  to  a 
resonance  condition  in  a room.  If  a wall  has  a reflection  coefficient  greater  than  0.80  and  the 
frequency  corresponds  to  resonance  for  the  room,  then  DREFL  is  set  to  the  reflection  coefficient  of 
the  wall  under  question.  Otherwise  DREFL  is  set  to  zero. 

DREFL:  This  is  the  return  variable.  (Used  in  common  block  ROOMD.) 

FLOW:  This  is  the  lower  frequency  bound  for  resonance. 

FHIGH:  This  is  the  upper  frequency  bound  for  resonance. 

FROM:  This  identifies  the  room  being  calculated. 

MATID:  This  represents  the  material  identification  label  for  the  wall  being  calculated. 

^FUNCTION  RCOEF  (MATID,  FREQ,  RFLAG) : This  function  returns  the  material  reflection  coefficient  for  a 
specified  frequency  and  for  a specified  quality. 

^SUBROUTINE  SETUP:  This  subroutine  loads  the  TMAT  array. 

^SUBROUTINE  SPWR:  This  subroutine  saves  the  energy  values  as  they  are  calculated  so  that  they  can  be 
formatted  neatly  when  printed. 

^SUBROUTINE  SRCHTDB  (ID,  PATTEN,  OAREA) : This  subroutine  searches  the  TDB  array  given  the  ID  label  of  a 
door  or  window  and  returns  the  attenuation  and  area  of  that  door  or  window. 

^FUNCTION  VAL  (String) : This  function  when  given  a number  expressed  as  a character  string  returns  the 
number  expressed  as  an  integer. 
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^’^SUBROUTINE  WARNING  (lERR):  This  subroutine  returns  an  error  message  when  called  with  a warning  number  as 


argument.  The  warning  number  and  message  follows: 


lERR  MESSAGE 

1 HOLE  data  file  does  not  exist  for  this  bldg. 

2 File  handling  problem  on  HOLE  data  file. 

3 MATTER  file  does  not  exist  for  this  bldg. 

4 File  handling  problem  on  MATTER  data  file. 

5 TYPE  data  file  does  not  exist  for  this  bldg. 

6 File  handling  problem  on  TYPE  file. 

7 WALL  data  file  does  not  exist  for  this  bldg. 

8 File  handling  problem  on  WALL  file. 

9 Height  and  width  of  room  missing. 

10  Length  of  room  missing. 

11  Frequency  file  does  not  exist  for  this  building. 

12  File  handling  problem  with  FREQ  file. 
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5.  USERS'  GUIDE  TO  COMPUTER  PROGRAMS  FOR  DATA  ENTRY  AND  COMPUTATION 


5.1  Introduction 

The  programs  discussed  in  this  chapter  have  been  written  for  use  on  the  Control  Data  Corporation 
Cyber  750  computer  at  the  Boulder,  Colorado  Laboratories  of  the  U.S.  Department  of  Commerce.  Though  the 
programs  contain  checks  and  tests  to  help  assure  their  correct  use,  we  urge  each  user  to  read  this  guide 
carefully  and  to  enter  data  (e.g.,  window  and  door  types  and  locations)  in  the  exact  form  and  sequence 
which  we  specify.  The  checks  and  tests  make  the  programs  somewhat  "user-friendly"  but  not  entirely  fool- 
proof (no  offense  intended). 

When  an  electromagnetic  wave  is  normally  incident  on  an  outside  wall  of  a building,  we  compute  the 
power  attenuation  of  the  wave  as  it  penetrates  the  building  by  a procedure  comprising  the  data  files 
BxxxxxF,  MATTER,  BxxxxxW,  BxxxxxT,  and  BxxxxxH,  and  the  program  MASTER. 

• BxxxxxF:  a file  containing  the  frequencies  to  be  used  in  the  calculation.  The  suffix  "F" 

stands  for  Frequency.  The  "xxxxx"  in  the  name  represents  the  identification  name  of  a 
building,  e.g.,  B90023F  would  be  the  frequency  data  file  for  building  number  90023.  This 
convention  is  used  for  all  the  other  data  files. 

• MATTER:  a file  containing  our  computed  reflection  coefficients  and  attenuation  values  for 

building  materials.  Users  will  have  direct  interaction  with  this  file  only  if  they  wish  to 
change  data  or  enter  additional  data  for  a material  already  in  the  file,  or  if  they  wish  to 
enter  data  for  an  additional  material. 

• BxxxxxW:  the  user  enters  data  on  the  location,  size,  and  composition  of  walls  in  the  building 

to  be  evaluated.  The  suffix  "W"  stands  for  Walls  data. 

• BxxxxxT:  for  each  door  and  window  type,  the  user  enters  material,  size,  and  a two-character 

identification.  The  suffix  "T"  stands  for  Types  data. 

• BxxxxxH:  in  this  file,  the  user  specifies  which  doors  and  windows  are  located  in  each  wall, 

identifying  the  door  and  window  types  by  their  two-character  codes.  The  suffix  "H"  stands  for 
Holes  data. 

• MASTER:  this  program  computes  the  power  attenuation  when  an  electromagnetic  field,  incident  on 

an  exterior  wall,  penetrates  into  any  room  of  a building.  MASTER  consults  the  files  MATTER, 
BxxxxxW,  BxxxxxT,  and  BxxxxxH  to  obtain  the  material  and  building  data  necessary  for  the  com- 
putation. It  uses  the  file  BxxxxxF  to  determine  which  frequencies  to  use. 

All  programs  are  written  in  FORTRAN  V for  use  on  the  CDC  750  computer. 
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5.2  Data  Preparation  for  Programs  SWALLS,  STYPES,  and  SHOLES 

The  sequence  ending  in  an  attenuation  computation  begins  with  the  user  drawing  a plan  of  the  build- 
ing to  be  analyzed.  This  plan  helps  the  user  derive  the  specifications  for  walls,  doors,  and  windows 
which  are  then  entered  into  the  data  files  BxxxxxW,  BxxxxxT,  and  BxxxxxH. 

At  this  point  we  discuss  typical  steps  in  reducing  the  floor  plan  in  figure  5.1  to  a set  of 
specifications  acceptable  to  MASTER.  The  procedures  we  illustrate  with  this  simple  example  can  be  used 
in  the  same  manner  for  more  complex  structures.  The  only  restriction  on  shape  is  that  the  floor  plan  be 
rectangular  or  composed  of  adjoining  rectangles.  The  same  restriction  applies  to  room  shapes.  Examine 
the  building  thoroughly  to  include  all  features  (walls,  doors,  windows)  that  determine  its  shielding 
characteristics . 

The  building  plan  must  be  labeled  as  follows  (see  the  example  in  fig.  5.1): 

1.  Dl,  D2,  D3,  D4  denote  the  exterior  regions,  or  "directions",  around  the  building.  These  re- 
gions must  be  labeled  in  order  to  specify  from  which  direction  the  radiation  is  coming.  If 
necessary,  D5  and  D6  can  be  the  regions  above  and  below  the  building,  or  above  and  below  a room 
(e.g.,  a second-floor  room). 

2.  The  directions  LR  (left-to-right)  and  FB  (front-to-back)  specify  which  walls  are  parallel  to 
each  other.  This  information  is  useful  if  two  parallel  walls  (of  the  same  room)  have  high 
reflection  coefficients,  because  the  region  between  them  may  contain  the  intensified  fields  of 
standing  waves  produced  by  reflections  between  the  walls.  The  program  MASTER  computes  the 
highest  and  lowest  frequencies  at  which  these  resonances  may  occur. 

3.  Label  the  rooms  01,  02,  03  . . .. 

4.  Determine  the  window  and  door  types  in  the  building;  label  these  WA,  WB,  ...,  and  DA,  DB,  ..., 
respectively,  at  their  locations  on  the  floor  plan. 

To  prepare  data  for  entry  into  the  file  BxxxxxW,  the  user  should  make  a data  sheet  to  specify  the 
size,  orientation,  and  composition  of  the  walls.  A suggested  format  is  shown  in  figure  5.2: 

1.  The  number  of  each  line  of  data  is  given  in  the  "LINE#"  column.  When  changing  or  entering  a 
line  of  data,  the  user  employs  the  line  number.  Note  that  the  line  numbers  are  shown  in  Figure 
5.1,  also. 

2.  The  column  "DIRECTION"  specifies  the  direction  to  which  the  wall  in  a given  line  is  perpen- 
dicular. This  direction  must  be  the  same  as  that  defined  by  the  "FROM"  and  "TO"  columns. 

3.  Note  that  lines  1,  2,  3 specify  the  material  layers  in  the  wall  between  region  D4  and  room  01, 
and  that  these  layers  are  encountered  in  that  sequence  in  going  from  D4  to  01.  The  material 
layers  in  a wall  must  be  entered  in  the  file  in  the  correct  sequence  corresponding  to  the 
direction  given  by  the  "FROM"  and  "TO"  columns . 
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4. 


The  wall  "HEIGHT"  (meters),  "LENGTH"  (meters),  and  "THICKNESS"  of  material  layer  (centimeters) 
are  entered  in  their  respective  columns. 

5.  The  material  identification  number  of  each  layer  is  entered  in  the  "MATERIAL"  column  according 
to  the  material  data  tables  in  chapter  2. 

We  strongly  advise  that  the  user  employ  some  means  of  marking  the  building  plan  as  each  wall  is  entered 
into  the  BxxxxxW  data  table.  When  the  table  is  complete  and  all  walls  are  so  marked  (e.g.,  a pencil 
check;  a colored  highlight),  the  user  will  know  that  none  have  been  omitted  (or  perhaps  entered  twice). 

It  can  also  be  helpful  to  put  the  data  table  line  numbers  onto  the  drawing  as  they  are  entered  into  the 
table.  In  figure  5.1,  these  line  numbers  are  shown  at  the  intersections  of  the  walls  with  the 
cross-sections  (dashed  lines)  through  the  building. 

To  tabulate  the  types  of  doors  (D)  and  windows  (W)  indicated  in  figure  5.1,  we  suggest  the  format  in 
figure  5.3.  From  left  to  right,  the  columns  specify  doors  and  windows  as  follows: 

1.  Line  numbers  (the  "LINE"  column)  are  used  in  adding,  deleting,  and  displaying  data. 

2.  The  floor  plan  in  figure  5.1  has  door  types  DA,  DB,  DC,  and  window  types  WA,  WB. 

3.  A door  or  window  has  a height  of  H meters  and  a width  of  W meters,  where  H and  W are  the  inside 

dimensions  of  a door  frame  and  a window  sash  (the  frame  in  which  the  glass  is  set). 

4.  "DISTANCE  ABOVE  FLOOR"  is  the  distance  in  meters  from  the  floor  to  the  bottom  edge  of  the  glass 
or  screen  in  a window. 

5.  In  the  next  two  columns,  the  "LAYER  MATERIAL"  (door  or  window)  and  its  "THICKNESS"  (in  cm)  are 

specified  for  each  door  and  window.  Notice  that  doors  and  windows  may  contain  more  than  one 

material:  window  type  WA  has  galvanized  mesh  screen  (material  M09)  and  window  glass  (M08).  The 
user  may  also  encounter  storm  windows,  windows  with  thermopane  (double-layer)  glass,  storm 
doors,  and  screen  doors. 

6.  "FRAME  MATERIAL";  obtain  identification  (e.g.,  M04)  for  the  frame  material  from  the  material 
data  tables. 

In  the  specification  of  walls  and  the  openings  in  them,  all  that  remains  now  is  to  prepare  data  for 
BxxxxxH,  the  holes  file  which  tells  MASTER  where  the  doors  and  windows  are  located.  A suitable  format 
for  tabulating  this  data  is  given  in  figure  5.4.  As  before,  a wall  is  identified  by  specifying  1)  the 
two  regions  between  which  the  wall  is  located  and  2)  the.  direction  to  which  the  wall  is  perpendicular 
(this  orients  the  wall  with  respect  to  left-right  or  front-back  directions).  Because  the  wall  "from  D4 
to  01"  has  two  types  of  openings,  it  is  listed  twice  (lines  3 and  4). 

We  again  urge  users  to  prepare  their  data  for  entry  into  the  computer  files  by  using  the  tabular 
formats  we  have  suggested  (figures  5.2,  5.3,  5.4).  This  procedure  will  reduce  careless  errors  in  tran- 
scribing building  specifications  from  the  floor  plan  to  files  BxxxxxW,  BxxxxxT,  and  BxxxxxH. 
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5.3  How  to  Become  a Remote-Site  Time-Share  User 


Having  prepared  a floor  plan  and  building  data  tables,  the  user  must  now  enter  this  data  into  the 
files  BxxxxxF,  BxxxxxW,  BxxxxxT,  and  BxxxxxH.  Before  we  present  details  of  how  this  is  done,  we  describe 
how  one  becomes  an  off-site  time-share  user  of  the  Control  Data  Corporation  (CDC)  170/750  computer  system 
at  the  Boulder  Laboratories  of  the  U.S.  Department  of  Commerce. 

To  establish  a relationship  with  the  computer,  call  User  Services:  (303)  497-5849  or  (303)  497-5850 
(on  FTS,  303  is  a direct  dial  area  code).  When  first  contacting  the  Computer  Services  Division  through 
User  Services,  prospective  users  must  furnish  1)  their  name,  organization  name,  and  telephone  number,  and 
2)  the  name  and  telephone  number  of  an  "authority  contact"  (i.e.,  a project  leader,  supervisor,  etc.). 
User  Services  will  then  provide  a user  number  and  an  initial  password.  When  a billing  account  is  estab- 
lished and  the  way  is  cleared  for  use  of  the  computer,  the  user  changes  the  initial  password  to  another 
one  which  is  then  secure,  known  only  to  the  user. 

A password  (4-7  alphanumeric  characters)  must  be  changed  every  three  months,  otherwise  the  computer 
will  assign  a new  one  known  only  to  the  computer.  The  user  will  then  be  unable  to  get  on  line  without 
first  going  through  User  Services  to  submit  a new  password.  At  each  log-in  for  about  ten  days  prior  to 
the  expiration  of  a password,  the  computer  reminds  the  user  to  enter  a new  one-  A password  is  changed  by 
the  command 

PASSWOR,  OLDPSWD,  NEWPSWD 

in  which  the  user  supplies  the  old  password  (OLDPSWD)  and  then  the  new  password  (NEWPSWD) . 

To  obtain  an  account  number  for  computer  charges,  the  user's  purchasing  department  should  send  a 
purchase  order  to 

Ms.  Beverly  Armstrong 
NOAA/ERL,  R-E52 
U.S.  Department  of  Commerce 
325  Broadway 

Boulder,  Colorado  80303. 

Ms.  Armstrong  can  be  reached  on  (303)  497-5842  (FTS  direct  dial). 

Dan  Smith  (303-497-5846)  or  Ron  Buxton  (303-497-5845)  can  advise  which  direct-dial  extension  to  use 
to  match  the  baud  rate  on  the  user's  terminal. 
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5.4  The  CDC  170/750:  Data  Entry  and  Computation 


5.4.1  Log-In  Procedure 

Once  the  user  is  on-line,  the  initial  conversation  with  the  computer  will  be  as  shown  in  figure  5.5. 
In  reply  to  the  first  three  requests,  the  user  enters:  family  name,  user  number,  and  password.  If  no 
family  name  is  required,  press  the  CR  key  (CR  = carriage  return).  When  typed,  the  user  number  does  not 
appear  on  the  printout.  The  password  is  typed  over  the  blackened  area.  After  the  word  "CHARGE:",  the 
user  enters 

CHARGE,  Z1234567,Z 

(or  a similar  form  specified  by  User  Services)  where  "1234567"  represents  the  user's  account  number.  As 
seen  in  this  printout,  entering  the  word  BYE  disconnects  the  user  from  the  computer. 

5.4.2  Procedure  File  MSTORE 

The  file  MATTER  contains  all  the  attenuation  and  reflection  data  in  the  tables  in  chapter  2.  To  add 
or  change  data,  one  uses  the  procedure  file  MSTORE  (M  for  material),  and  obtains  it  with  the  BEGIN  com- 
mand 

BEGIN,  MSTORE 

Figure  5.6  illustrates  how  the  user  enters  building  material  data  by  means  of  MSTORE,  which  first  asks  if 
the  user  wants  to  (1)  create  a new  data  base,  or  (2)  add  to  the  existing  data  base.  The  user  makes  the 
choice  by  typing  1 or  2 after  the  question  mark.  (Note  that  whenever  MSTORE  awaits  a user  reply,  it 
types  a question  mark  as  a prompt  to  the  user.)  If  a data  base  is  already  present  in  the  MATTER  file  and 
the  user  chooses  to  create  a new  data  base,  typing  1 ERASES  THE  EXISTING  BASE.  Before  making  this  choice, 
the  user  must  be  certain  this  is  indeed  what  is  wanted.  Also,  one  must  take  care  not  to  inadvertently 
type  the  numeral  1 when  2 is  intended. 

The  entry  of  material  description  and  data  is  complete  when  the  user  has  responded  to  the  six 
prompts.  (NOTE:  a character  string  must  be  typed  within  single  quotes;  e.g.,  'MOIST  CLAY  BRICK',  'M15'.) 
MSTORE  then  presents  the  choice  of  (1)  adding  data  for  another  material,  (2)  changing  data  in  the  base, 

(3)  displaying  the  data  for  material  in  the  base,  (4)  canceling  (aborting)  the  data  set  just  entered,  or 
(5)  quitting  the  data-entry  procedure.  The  choice  (5)  enters  the  new  data  into  the  file  MATTER. 

Figure  5.7  shows  the  user  how  to  use  MSTORE  to  change  data  already  in  MATTER.  After  the  material 
identification  M05  is  entered,  MSTORE  prints  all  specifications  for  M05,  and  the  user  then  enters  the 
line  number  of  the  data  to  be  changed.  The  procedure  to  change  the  attenuation  quality  percent  from  100 
to  10  is  then  self-evident.  After  all  changes  have  been  made  and  the  user  has  entered  99  to  leave  the 
"change"  mode,  the  complete  revised  data  for  M05  is  presented.  Entering  5 (the  "quit"  option) 
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disconnects  the  user  from  MSTORE  and  enters  the  revised  data  into  the  file  MATTER.  To  reestablish 
contact  with  the  procedure  file  MSTORE,  the  user  must  again  enter  BEGIN,  MSTORE. 

The  entire  data  entry  for  a material  can  be  deleted  simply  by  using  the  "change"  option  to  replace 
the  material  identification  in  line  1 (e.g.,  M05)  with  a blank.  Enter  two  consecutive  single  quotes  as 
the  changed  material  ID;  the  absence  of  information  between  them  is  the  blank. 

5.4.3  Data  File  BxxxxxW  (W  for  Walls) 

In  the  file  BxxxxxW,  the  user  stores  the  location,  dimensions,  and  composition  of  each  wall  in  each 

building  to  be  analyzed.  Every  building  thus  specified  in  BxxxxxW  must  be  identified  by  a string  of  no 

more  than  five  alphanumeric  characters  represented  by  xxxxx  here.  Building  identification  is  the  first 
information  requested  as  the  user  begins  entering  or  changing  data  in  the  BxxxxxW  file. 

Manipulating  data  in  BxxxxxW  is  done  through  the  procedure  file  WSTORE;  that  is,  WSTORE  is  the  pro- 
cedure file  by  which  the  user  creates  and/or  alters  the  data  file  BxxxxxW.  Contact  with  BxxxxxW  is 
therefore  initiated  by  the  command 

BEGIN,  WSTORE 

Figure  5.8(a)  illustrates  the  format  for  entering  data,  via  WSTORE,  into  the  file  BxxxxxW.  First,  the 
user  enters  an  identification  number  assigned  to  the  building  whose  walls  are  to  be  documented.  This 

identification  number  replaces  the  "xxxxx"  in  the  file  name  forming  a unique  name.  Then  comes  the  payoff 

for  care  taken  in  tabulating  wall  data  (fig.  5.2),  for  WSTORE  now  requests  this  data  in  the  left-to-right 
order  of  the  tabulation.  Note  that  when  data  has  been  entered  for  a wall  layer,  entering  another  layer 
for  that  wall  requires  only  "thickness  of  layer"  and  "material  ID"  (directional  data,  height,  and  width 
are  the  same  for  all  layers  in  a given  wall).  If  the  user  discontinues  data  entry,  WSTORE  presents  the 
seven  options  at  the  top  of  figure  5.8(b). 

Option  1:  a line  can  be  displayed  as  shown  in  figure  5.8(b).  Entering  the  number  "0"  instead  of  a 

line  number  allows  the  user  to  leave  the  display  mode. 

Option  2:  options  2 and  5 are  similar  in  that  they  both  involve  adding  data  lines  to  an  existing 
file.  While  5 is  only  for  adding  a data  line  at  the  end  of  the  file,  option  2 allows  the  user  to 
insert  a data  line  between  two  other  lines  (fig.  5.8(c)).  When  this  is  done,  the  inserted  line  must 
be  part  of  a wall  already  represented  in  the  file  (otherwise,  option  5 would  be  used).  For  this 
reason,  the  user  must  be  sure  that  the  directions,  height,  and  width  of  the  inserted  line  match 
those  of  one  (or  perhaps  both)  of  the  adjacent  lines  (depending  on  whether  one  or  both  of  the  adja- 
cent lines  belong  to  the  door/window  of  the  inserted  line).  If  the  user  enters  the  data  incorrectly 
and  the  line  does  not  match  at  least  one  of  its  neighbors,  WSTORE  will  emphatically  point  out  the 
error.  This  error  message  is  shown  at  the  bottom  of  figure  5.8(c).  Note  that  the  faulty  line  has 
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not  been  accepted  (i.e.,  not  entered  into  the  BxxxxxW  files);  the  user  must  again  choose  option  2 
and  enter  the  corrected  data. 

Option  3:  this  option  allows  the  user  to  delete  a line  of  data  (fig.  5.8(d)).  The  procedure  is 

self-explanatory.  Revised  data  can  be  entered  using  option  2 or  5,  whichever  is  appropriate. 

Option  4:  displays  all  data  for  this  building  so  far  entered  into  BxxxxxW. 

Option  5:  adds  a line  of  data  at  the  end  of  an  existing  file.  If  the  added  line  is  another  layer 
in  the  last  wall  in  the  file,  the  user  is  asked  only  for  layer  thickness  and  material  ID.  If  the 
added  line  is  the  first  layer  of  a new  wall  in  the  file,  the  format  for  entering  the  data  is  the 
same  as  in  option  2 (fig.  5.8(c)).  Neither  choice  within  option  5 requires  matching  the  entered 
data  with  that  in  an  adjacent  line. 

Options  6 and  7:  option  6 (fig.  5.8(d))  stores  new  data  in  file  BxxxxxW,  or  replaces  existing  data 

in  BxxxxxW  with  a revised  version  of  that  data.  If  the  user  does  not  wish  to  store  the  new  or  revis- 
ed data  just  entered,  option  7 can  be  used  to  cancel  that  data  and  leave  the  BxxxxxW  file  unchanged. 

5.4.4  Data  File  BxxxxxT  (T  for  Types) 

In  this  file  the  user  stores  data  from  the  table  of  door  and  window  types  and  specifications 
(fig.  5.3).  The  procedure  for  entering  this  data  is  TSTORE,  and  the  procedures  for  data  entry,  the 
cautionary  comments,  and  the  error  messages  are  almost  identical  to  those  employed  in  the  procedure 
WSTORE.  Therefore,  familiarity  with  WSTORE  is  sufficient  warmup  for  using  the  procedure  TSTORE  to  enter 
data  into  the  file  BxxxxxT.  Figure  5.9  illustrates  the  format  for  data  entry  using  TSTORE;  the  similar- 
ity with  WSTORE  is  obvious. 

Because  doors  and  windows  may  have  layers  (e.g.,  storm  doors,  storm  windows,  screens),  an  insert- 
line-into-f ile  option  is  again  one  of  seven  data-handling  choices  available.  As  in  WSTORE,  an  inserted 
line  of  data  represents  an  additional  layer  of  a door  or  window  already  in  the  file.  Therefore,  the 
identifier  (e.g.,  DE,  WC),  frame  material,  height,  width,  and  distance  above  floor  in  the  inserted  line 
must  match  those  specifications  in  one  or  both  of  the  adjacent  lines.  If  not,  the  error  message  and  the 
procedure  for  changing  the  incorrect  line  of  data  are  the  same  as  in  WSTORE. 

The  user  gains  access  to  TSTORE  with  the  command 

BEGIN,  TSTORE. 

Building  identification  is  required  before  data  entry  begins. 

5.4.5  Data  File  BxxxxxH  (H  for  Holes) 

The  user  stores  in  the  file  BxxxxxH  the  types  and  locations  of  all  doors  and  windows  in  the  building 
to  be  analyzed;  location  is  given  by  specifying  the  wall  containing  each  door  and  window.  This  data 
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should  have  been  previously  tabulated  as  in  figure  5.4,  and  is  now  to  be  entered  into  the  data  file 
BxxxxxH  by  means  of  the  procedure  HSTORE.  Again,  the  summons  is 

BEGIN,  HSTORE 

and  building  identification  is  required  to  initiate  data  entry  (fig.  5.10). 

Though  not  necessary,  it  may  be  a bookkeeping  convenience  to  enter  together  the  data  for  all  doors 
and  windows  in  a given  wall.  If  option  2 ("insert  line  into  file")  is  employed  for  this  purpose,  the 
user  will  be  pleased  to  know  that  HSTORE  does  not  require  matching  between  inserted  and  adjacent  lines. 
Therefore,  HSTORE,  while  very  similar  to  MSTORE,  WSTORE,  and  TSTORE,  is  also  simpler  and  will  present  no 
difficulties  to  a user  familiar  with  the  other  three  data  entry  programs. 

5.4.6  Data  File  BxxxxxF  (F  for  Frequency) 

The  user  stores  in  the  file  BxxxxxF  the  frequencies  required  for  the  calculation  using  the  procedure 
file  FSTORE.  The  program  is  begun  by  the  command, 

BEGIN,  FSTORE. 

If  no  BxxxxxF  file  is  created,  the  program  MASTER  will  use  a set  of  default  frequencies  in  the 
calculation. 

5.4.7  Computation  Program  MASTER 

The  program  MASTER  obtains  building  data  from  the  files  MATTER,  BxxxxxW,  BxxxxxT,  and  BxxxxxH,  and 
computes  the  attenuation  (in  dB)  for  each  room;  that  is,  the  attenuation  of  externally  incident  radiation 
as  it  penetrates  into  each  room  of  the  building.  The  user  must  be  sure  these  files  contain  all  the 
necessary  data  before  consulting  MASTER.  When  the  files  are  ready,  the  user  activates  MASTER  by  entering 

BEGIN,  FIELD. 

The  procedure  file  FIELD  summons  MASTER,  the  data  files,  and  the  subroutines  required  by  MASTER  for  its 
data  handling  operations.  The  only  information  that  FIELD  asks  of  the  user  is  the  identification  code  of 
the  building  to  be  analyzed.  When  the  user  enters  this  building  identification,  the  computation  begins. 

For  each  of  the  five  directions  from  which  radiation  may  be  incident  on  the  building  (e.g.,  north, 
east,  south,  west,  above),  MASTER  computes  all  room  attenuations  for  the  frequencies  given  in  the  data 
file  BxxxxxF.  If  the  frequency  file  is  missing,  MASTER  will  use  the  seven  default  frequencies  given  in 
the  material  data  tables.  The  printed  output  begins  with  a listing  of  the  data  files  BxxxxxW,  BxxxxxH, 
and  BxxxxxT  (fig.  5.11a);  then  the  attenuation  values  are  given  (fig.  5.11b)  by  frequency,  direction,  and 
room.  The  data  in  figure  5.11  a,b  are  for  the  sample  building  whose  wall,  door,  and  window  specifica- 
tions were  obtained  from  figure  5.1.  Actual  results  based  on  field  measurements  are  shown  in  chapter  7. 
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DIRECTION  Dl 


FB  FB 


DIRECTION  D3 


FLOOR  PLAN  OF  SAMPLE  BUILDING 


NOTES: 

WINDOW  DATA 

WA  1.2  m (H)  X 0.91  m (W),  plywood  frame,  1 cm  glass 
with  0.61  cm  thick  24x24  galvanized  steel  mesh 

WB  1.2  m (H)  X 1.5  m (W),  aluminum  frame,  1 cm  glass 
with  0.61  cm  thick  24x24  galvanized  steel  mesh 

DOORS 

DA  2.10  m (H)  x 0.91  m (W)  plywood  door,  5.1  cm  thick 
with  wood  frame 

DB  2.10  m (H)  x 1.20  m (W)  plywood  door  5.1  cm  thick 
with  wood  frame 

DC  2.10  m (H)  X 2.10  m (W)  plywood  door  1.3  cm  thick 
with  aluminum  frame 


WALLS 


All  heights  are  2.44  m. 
FLOOR 


Cement  1.30  cm  thick. 
CEILING 

Wood  (Fir)  130  cm 


Figure  5.1  Layout  of  sample  building  used  for  illustrating  data  input. 
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1 

z 

3 

4 

5 

i 

1 

8 

9 

10 

1 1 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 


ECTION 

FROM 

TO 

HEIGHT 

WIDTH 

THICKNESS 

MATERIAL 

LR 

D4 

01 

2 . 44 

4 .57 

1 .30 

M05 

LR 

D4 

01 

2 . 44 

4 . 57 

1 . 30 

M06 

LR 

D4 

01 

2 . 44 

4 .57 

1 . 30 

MO  4 

LR 

01 

02 

2 . 44 

1 . 22 

1 . 30 

M06 

LR 

02 

D2 

2 .44 

1 . 22 

20  .30 

MO  7 

LR 

02 

D2 

2 . 44 

1 . 22 

1 .30 

M06 

LR 

01 

03 

2 , 44 

3 . 35 

1 .30 

MO  6 

LR 

03 

D2 

2 . 44 

3 . 35 

20  .30 

M07 

LR 

03 

D2 

2 . 44 

3 . 35 

1 .30 

MO  6 

FB 

D3 

01 

2 . 00 

3 . 66 

1 . 30 

MO  6 

FB 

01 

D1 

2 . 44 

3 . 66 

1 .30 

MO  6 

FB 

D3 

03 

2 . 44 

3 . 66 

1 .30 

M06 

FB 

03 

02 

2 . 44 

3 . 66 

1 .30 

M05 

FB 

03 

02 

2 . 44 

3 . 66 

1 .30 

M06 

FB 

02 

D1 

2 . 44 

3 .66 

1 .30 

MO  6 

UD 

D5 

01 

4 .57 

3 . 66 

1 . 30 

M04 

UD 

01 

D6 

4 . 57 

3 .66 

1 .30 

MO  2 

UD 

D5 

02 

1 .22 

3 . 66 

1 . 30 

M04 

UD 

02 

D6 

1 . 22 

3 .66 

1 .30 

MO  2 

UD 

D5 

03 

3 . 35 

3.66 

1 .30 

MO  4 

UD 

03 

D6 

3 35 

3 .66 

1 .30 

MO  2 

5.2.  Example  of  wall  data  tabulation  for  walls  in  figure  5.1. 
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LINE 

ID 

HEIGHT 

WIDTH 

DISTANCE 

THICKNESS 

LAYER 

FRAME 

(METERS) 

(METERS) 

ABOVE  FLOOR 

(CM) 

MATERIAL 

MATERIAL 

1 

DA 

2.10 

. 91 

0 . 00 

5.10 

MO  5 

M05 

2 

DB 

2.10 

1 . 20 

0 . 00 

5.10 

M05 

MO  5 

3 

DC 

2.10 

2 . 10 

0 . 00 

1 . 30 

MO  5 

Ml  3 

4 

UA 

1 . 20 

.91 

. 61 

1 . 00 

M08 

M05 

5 

WA 

1 . 20 

. 91 

.61 

.61 

MO  9 

M05 

6 

VB 

1 . 20 

1 .50 

.91 

1 . 00 

M08 

Ml  3 

7 

WB 

1 . 20 

1 . 50 

.91 

.61 

M09 

Ml  3 

Figure  5.3.  Format  for  preparing  door  and  window  specifications  for  entry  into  file  BxxxxxT. 


LINE  « 

DIRECTION 

FROM 

TO 

ID 

1 

LR 

03 

D2 

UB 

2 

FB 

D3 

03 

DB 

3 

LR 

D4 

01 

WA 

4 

LR 

D4 

01 

DA 

5 

LR 

01 

02 

DC 

6 

LR 

01 

03 

DC 

7 

FB 

01 

D1 

WA 

8 

FB 

02 

D1 

WB 

9 

LR 

02 

D2 

WA 

Figure  5.4.  Format  for  preparing  door  and  window  location  data  for  entry  into  file  BxxxxxH  (sample  data 
from  figure  5.1). 


83/09/M.  M.M.30 

NOAA/MASC  170/750  83/06/26.  NOS  1.4  531/552.40 

FAMILY ; 

USER  NUMBER; 

PASSWORD 

XXXX2XX2 

TERMINAL:  220,  TTY 

RECOVER/  CHARGE;  CHARGE , Z72  33  4 91  ,2 


/BYE 

WYSS 

LOG  OFF 

14  . 

14.49. 

UYSS 

SRU 

1 .002 

UNTS. 

Figure 

5.5. 

The  log-in  procedure 
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/BEGIN, MSTORE . 

(1)  CREATE  NEW  DATABASE  (2)  ADD  TO  EXISTING  DATA  BASE 
? 2 

(1)  NEXT  DATA  ENTRY  <2>  CHANGE  (3)  DISPLAY  (4)  ABORT  (5)  QUIT 
? 1 

MATERIAL  ID?  (E.G.  M05  OR  M12) 

? 'MIS’ 

INDEX; 15 

ENTER  ONE  LINE  DESCRIPTION  OF  MATERIAL 
? 'MOIST  CLAY  BRICK' 

ENTER  7 ATTENUATION  VALUES  FROM  LOW  TO  HIGH  FREQ 
? 0000022,. 0000102,. 00014,. 0025,. 00572,. 00572,. 0057 

ENTER  ATTENUATION  QUALITY  PERCENT 
? 10  . 

ENTER  7 REFLECTION  COEFFS  FROM  LOW  TO  HIGH  FREQ 
? . 1 3 , . 07  2 , . 05  1 , . 02  9 , . 0 1 4 , . 0 1 4 , . 0 1 4 

ENTER  REFLECTION  COEFICIENT  QUALITY  PERCENT 
? 100  . 

(1)  NEXT  DATA  ENTRY  (2)  CHANGE  (3)  DISPLAY  (4)  ABORT  (5)  QUIT 
? 5 

REVERT.  MSTORE  COMPLETED. 

/ 


Figure  5.6.  Entering  building  material  data  into  the  file  MATTER. 
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/BEGIN, MSTORE 

(1)  CREATE  NEW  DATABASE  (2)  ADD  TO  EXISTING  DATA  BASE 
’ 2 

(1)  NEXT  DATA  ENTRY  (2)  CHANGE  (3)  DISPLAY  (4)  ABORT  (5)  QUIT 
’ 2 

ENTER  MATERIAL  I D OF  GROUP  TO  BE  CHANGED 
» 'M05' 

LINE  1 MATERIAL  ID 

M04 

LINE  2 DESCRIPTION 

FIR  PLYWOOD 

LINE  3:  FREQUENCIES 

10000.  100000.  1000000.  10000000.  100000000.  1000000000. 

1 EflO 

LINE  4:  ATTENUATIONS 

OOOOOllS  .00000677  .00000831  .000124  .00215  .026  .3 
LINE  5 ATTENUATION  QUALITY  PERCENT 

100  . 

LINE  6.  REFLECTION  COEFFICIENTS 

06B  048  .074  036  .014  .013  . 01 

LINE  7.  REFLECTION  QUALITY  PERCENT 
1 00 

ENTER  NUMBER  OF  LINE  TO  BE  CHANGED  (99  TO  END  CHANGES) 

? 5 

ENTER  NEW  ATTENUATION  QUALITY  PERCENT 
? 10  . 

ENTER  NUMBER  OF  LINE  TO  BE  CHANGED  (99  TO  END  CHANGES) 

? 99 

HOS 

FIR  PLYWOOD 

10000.  100000.  1000000.  10000000.  100000000.  1000000000. 

1 E+10 

.00000115  .00000677  .00000831  .000124  .00215  .026  .3 
10  . 

.068  .048  .074  .036  .014  .013  .01 
100  . 

(1)  NEXT  DATA  ENTRY  (2)  CHANGE  (3)  DISPLAY  (4)  ABORT  (5)  QUIT 
? 5 

REVERT.  MSTORE  COMPLETED. 

/ 


Figure  5.7.  Changing  building  material  data  in  the  file  MATTER  by  means  of  the  procedure  file  MSTORE. 
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/BEGIN, USTORE . 


ENTER  BUILDING  IDENTIFICATION  (E.G.  *101') 
(NO  MORE  THAN  5 ALPHANUMERIC  CHARACTERS) 
» '701  • 


WILL  THIS  BE 

(1)  A MODIFICATION  OF  AN  EXISTING  FILE? 

(2)  A NEW  FILE? 

ENTER  A NUMBER  ! ! ! 

? 2 

BEGIN  ENTERING  DATA 

ENTER  DIRECTION  (E.  G.  ' LR ' ) 

? 'LR' 

ENTER  "FROM"  (EG.  '02'  OR  'Dl') 

? 'D4  ' 

ENTER  "TO"  (E.G.  '02'  OR  'Dl' ) 

? ' 01  ' 

ENTER  HEIGHT,  METERS 
? 2.44 

ENTER  WIDTH,  METERS 
? 4.57 

ENTER  THICKNESS  OF  LAYER,  CENTIMETERS 
? 1.30 

ENTER  "MATERIAL  ID"  (EG.  'MOl') 

? 'MOS' 

DO  YOU  WANT  TO  ENTER  MORE  DATA?(1)  YES  (2)  NO 
ENTER  A NUMBER  ! ! ! 

? 1 

IS  THIS  THE  FIRST  LAYER  OF  A WALL  (1)  YES  (2)  NO 
ENTER  "0"  TO  ESCAPE  "DATA  ENTRY"  MODE 
ENTER  A NUMBER! I 
? 2 

ENTER  THICKNESS  OF  LAYER,  CENTIMETERS 
? 1.30 

ENTER  "MATERIAL  ID"  (E.G.  'MOl') 

? 'M06' 


DO  YOU  WANT  TO  ENTER  MORE  DATA?(1)  YES  (2)  NO 
ENTER  A NUMBER  I I I 

? 2 

DATA  ENTRY  DISCONTINUED 


Figure  5.8(a) . 


Procedure  file  WSTORE  is  used  to  enter  wall  data  into  file  BxxxxxW.  Data  is  entered  in 
the  sequence  of  columns  in  figure  5.2. 
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CHOOSE 

(1 ) DISPLAY  LINE  OF  DATA 


(4)  DISPLAY  ALL  LINES 


(2)  INSERT  LINE  INTO  FILE  (5)  APPEND  LINES  OF  DATA 


(3)  DELETE  LINE 


ENTER  A NUMBER  ! ! ! 


(6)  STORE  DATA  AND  EXIT  PROGRAM 

(7)  EXIT  PROGRAM  WITHOUT  STORING  DATA 


» 1 


SPECIFY  THE  NUMBER  OF  THE  LINE  TO  BE  DISPLAYED 
( ENTER  "0"  TO  ESCAPE  DISPLAY  MODE  ) 

' 1 


LINE  I DIRECTION 
1 LR 


FROM 

D4 


TO 

01 


HEIGHT 
2 . 44 


WIDTH 
4 .57 


THICKNESS 
1 .30 


MATERIAL 
MO  5 


CHOOSE 

(1)  DISPLAY  LINE  OF  DATA 


(4)  DISPLAY  ALL  LINES 


(2)  INSERT  LINE  INTO  FILE  (5)  APPEND  LINES  OF  DATA 


(3)  DELETE  LINE 


ENTER  A NUMBER  I ! ! 


(6)  STORE  DATA  AND  EXIT  PROGRAM 

(7)  EXIT  PROGRAM  WITHOUT  STORING  DATA 


» 6 


DOUBLE  CHECK  ! ! ! 

DO  YOU  YOU  WANT  TO  STORE  THIS  DATA  AND  END  PROG 
NOTE:  STORING  THIS  DATA  WILL  WIPE  OUT  ANY  OLD  FILE 
OF  THE  SAME  NAME  ! ! ! 

ENTER  A NUMBER:  (1)  YES  (2)  NO 

? 1 

DATA  HAS  BEEN  STORED  AND  PROGRAM  TERMINATED 
REVERT.  WSTORE  COMPLETED. 

/ 

Figure  5.8(b).  (Continued  from  figure  5.8(a))  How  the  display  mode  allows  the  user  to  examine  a line 
of  data. 
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/BEGIN, WSTORE . 


ENTER  BUILDING  IDENTIFICATION  (E.G,  '101') 
(NO  MORE  THAN  5 ALPHANUMERIC  CHARACTERS) 
? '701' 


WILL  THIS  BE 

(1)  A MODIFICATON  OF  AN  EXISTING  FILE? 

(2)  A NEW  FILE? 

ENTER  A NUMBER  ! ! ! 

? 1 

CHOOSE 

(1)  DISPLAY  LINE  OF  DATA 

(2)  INSERT  LINE  INTO  FILE 

(3)  DELETE  LINE 

ENTER  A NUMBER  ! ! ! 

? 2 

SPECIFY  NUMBER  OF  LINE  BEFORE  WHICH  A NEW  LINE  IS  TO  BE  INSERTED 
( ENTER  "0"  TO  ESCAPE  "INSERTION"  MODE  ) 

? 2 

ENTER  DIRECTION  (E.  G.  ' LR ' ) 

? 'LR' 

ENTER  "FROM"  (E.G.  '02'  OR  'Dl') 

? ' 06  ' 

ENTER  "TO"  (E.G.  '02'  OR  'Dl') 

? ' 05  ' 

ENTER  HEIGHT,  METERS 
? 2.44 

ENTER  WIDTH,  METERS 
? 2.0 

ENTER  THICKNESS  OF  LAYER,  CENTIMETERS 
? 2.0 

ENTER  "MATERIAL  ID"  (EG.  'MOl') 

? 'MOl' 


(4)  DISPLAY  ALL  LINES 

(5)  APPEND  LINES  OF  DATA 

(6)  STORE  DATA  AND  EXIT  PROGRAM 

(7)  EXIT  PROGRAM  WITHOUT  STORING  DATA 


YOUR  DATA  WAS  NOT  ACCEPTED  ! ! ! 

YOUR  DATA  MUST  REPRESENT  A LAYER  IN  AN  EXISTING  WALL 
I.E.  THE  DIRECTION,  FROM,  TO,  HEIGHT,  AND  WIDTH 
PARAMETERS  MUST  MATCH  THE  WALL  JUST  BEFORE 
OR  JUST  AFTER  YOUR  SPECIFIED  INSERTION  POINT 


THE  FOLLOWING  DISPLAYS 
THE  LINE  BEFORE  YOUR  LINE, 
YOUR  LINE,  AND  THE  LINE  AFTER 


LINE 

• 

DIRECTION 

FROM 

TO 

HEIGHT 

WIDTH 

THICKNESS 

MATERIAL 

1 

LR 

D4 

01 

2 .44 

4.57 

1 .30 

MOS 

LINE 

t 

DIRECTION 

FROM 

TO 

HEIGHT 

WIDTH 

THICKNESS 

MATERIAL 

2 

LR 

06 

05 

2 . 44 

2 .00 

2 . 00 

MOl 

LINE 

t 

DIRECTION 

FROM 

TO 

HEIGHT 

WIDTH 

THICKNESS 

MATERIAL 

3 

LR 

D4 

01 

2 . 44 

4 .57 

1 .30 

NO  6 

Figure  5.8(c). 


The  WSTORE  sequence  for  inserting  data  into  the  file  BxxxxxW.  Note  error  message  when  an 
incorrect  line  is  inserted. 
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CHOOSE 

U)  DISPLAY  LINE  OF  DATA  (4)  DISPLAY  ALL  LINES 

(2>  INSERT  LINE  INTO  FILE  (5)  APPEND  LINES  OF  DATA 

(3)  DELETE  LINE  (i)  STORE  DATA  AND  EXIT  PROGRAM 

(7)  EXIT  PROGRAM  WITHOUT  STORING  DATA 

ENTER  A NUMBER  ! ! ! 

’ 3 

SPECIFY  THE  NUMBER  OF  THE  LINE  TO  BE  DELETED 
(ENTER  "0“  TO  ESCAPE  DELETION  MODE) 

’ 1 

DOUBLE  CHECK  ! ! ! 

DO  YOU  WANT  TO  DELETE  THE  FOLLOWING  LINE?: 

LINE  • DIRECTION  FROM  TO  HEIGHT  WIDTH  THICKNESS  MATERIAL 


1 

LR 

D4 

01 

2.44  4.57 

1 .30 

ENTER  (1)  YES  OR 

1 

(2)  NO 

LINE  • 

1 DELETED 

CHOOSE 

(1  ) 

DISPLAY  LINE  OF 

DATA 

(4) 

DISPLAY  ALL  LINES 

(2) 

INSERT  LINE  INTO 

FILE 

(5) 

APPEND  LINES  OF  DATA 

(3  ) 

DELETE  LINE 

(&) 

STORE  DATA  AND  EXIT 

PROGRAM 

(7) 

EXIT  PROGRAM  WITHOUT 

STORING  DATA 

ENTER  A 

NUMBER  ! ! ! 

? 6 

DOUBLE  CHECK  ! ! ! 

DO  YOU  YOU  WANT  TO  STORE  THIS  DATA  AND  END  PROG 
NOTE:  STORING  THIS  DATA  WILL  WIPE  OUT  ANY  OLD  FILE 
OF  THE  SAME  NAME  ! ! ! 

ENTER  A NUMBER:  (1)  YES  (2)  NO 

? 1 

DATA  HAS  BEEN  STORED  AND  PROGRAM  TERMINATED 
REVERT.  WSTORE  COMPLETED. 

/ 

Figure  5.8(d).  WSTORE:  how  to  delete  data  (option  3),  and  use  of  option  6 to  store  entered  data  and 
terminate  WSTORE. 
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/BEGIN,  TSTORE 


ENTER  BUILDING  IDENTIFICATION  (E  . G . TOl') 

(NO  MORE  THAN  5 ALPHANUMERIC  CHARACTERS) 

? 701 

701  (-ERROR  IN  COL.  4,  RETYPE  RECORD  FROM  THIS  FIELD 

? '701' 


WILL  THIS  BE 

(1)  A MODIFICATION  OF  AN  EXISTING  FILE? 

(2)  A NEW  FILE? 

ENTER  A NUMBER  !!! 

? 2 

BEGIN  ENTERING  DATA 

ENTER  TD'  (E  G.  ’WA‘  OR  'DE'> 

? ’WA' 

ENTER  HEIGHT,  METERS 
? 2 

ENTER  WIDTH,  METERS 
? .98 

ENTER  DISTANCE  ABOVE  FLOOR,  METERS 
? 1 

ENTER  THICKNESS  OF  LAYER,  CENTIMETERS 
? A 

ENTER  "MATERIAL  ID  OF  LAYER"  (E.G.  'MOl') 

? 'M05‘ 

ENTER  "MATERIAL  ID  OF  FRAME"  (E.G.  'MOl') 

? 'M08' 


DO  YOU  WANT  TO  ENTER  MORE  DATA?(1)  YES  (2)  NO 
ENTER  A NUMBEER  !!! 

? 1 

IS  THIS  THE  FIRST  LAYER  OF  A DOOR  OR  WINDOW?  (1)  YES  (2)  NO 
ENTER  "0"  TO  ESCAPE  "DATA  ENTRY"  MODE 
ENTER  A NUMBER!! 

? 2 

ENTER  THICKNESS  OF  LAYER,  CENTIMETERS 
? 1 

ENTER  "MATERIAL  ID  OF  LAYER"  (E.G.  'MOl') 

? 'M04' 


DO  YOU  WANT  TO  ENTER  MORE  DATA?(1)  YES  (2)  NO 
ENTER  A NUMBEER  !!! 

? 2 

DATA  ENTRY  DISCONTINUED 
CHOOSE 

(1)  DISPLAY  LINE  OF  DATA  (4)  DISPLAY  ALL  LINES 

(2)  INSERT  LINE  INTO  FILE  (5)  APPEND  LINES  OF  DATA 

(3)  DELETE  LINE  (6)  STORE  DATA  AND  EXIT  PROGRAM 

(7)  EXIT  PROGRAM  WITHOUT  STORING  DATA 

ENTER  A NUMBER  !!! 


Figure  5.9.  The  proce(iure  TSTORE  enters  data  on  door  and  window  types  into  file  BxxxxxT. 
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/BEGIN, H3T0RE 


ENTER  BUILDING  IDENTIFICATION  (E.G.  '101') 

(NO  MORE  THAN  5 ALPHANUMERIC  CHARACTERS) 
’ • 70  I • 


WILL  THIS  BE 

(1)  A MODIFICATION  OF  AN  EXISTING  FILE? 

( 2 ) A NEW  FILE? 

ENTER  A NUMBER  ! ! ! 

’ 2 

BEGIN  ENTERING  DATA 

ENTER  DIRECTION  <E  G.  ’ LR ' ) 

’ ' LR  ' 


ENTER  "FROM"  (E.G.  ‘02'  OR  'Dl') 

’ ‘D2  ' 

ENTER  "TO"  (EC.  ‘02‘  OR  'Dl ' > 

? ' 03  ' 

ENTER  HOLE  'ID'  (E.G.  ' WA ' OR  'DA') 

? 'WB ' 


DO  YOU  WANT  TO  ENTER  MORE  DATA?(1)  YES  (2)  NO 
ENTER  A NUMBER  ! ! ! 

? 1 

ENTER  DIRECTION  (E  G . ‘ LR  ' ) 

? 'TB ' 

DIRECTION  MUST  BE  'LR'  OR  • fb ' OR  ' UD ' 

TRY  AGAIN! I ! 

ENTER  DIRECTION  (E . G . ' LR ' ) 

? -fB' 

ENTER  "FROM"  (E.G.  '02'  OR  'Dl') 

? 'D3  ' 

ENTER  "TO"  (EG.  '02'  OR  'Dl') 

? ' 03  ' 

ENTER  HOLE  'ID'  (E.G.  'WA'  OR  'DA') 

? 'DB' 


DO  YOU  WANT  TO  ENTER  MORE  DATA?(1)  YES  (2)  NO 
ENTER  A NUMBER  ! I ! 

? 2 

DATA  ENTRY  DISCONTINUED 
CHOOSE 


( 1 ) 

DISPLAY 

LINE 

OF 

DATA 

(4) 

DISPLAY  ALL  LINES 

(2) 

INSERT 

LINE 

INTO 

FILE 

(5) 

APPEND  LINES  OF  DATA 

(3) 

DELETE 

LINE 

(6) 

STORE  DATA  AND  EXIT 

PROGRAM 

(7) 

EXIT  PROGRAM  WITHOUT 

STORING  DATA 

ENTER 

A NUMBER 

I I ! 

? 4 


LINE 

t 

DIRECTION 

FROM 

TO 

ID 

1 

LR 

D2 

03 

WB 

2 

FB 

D3 

03 

DB 

re  5. 

10. 

Procedure 

HSTORE 

enters 

into  file  BxxxxxH  the  types  and  locations  of  doors  and  windows 

55 


/BEGIN, FIELD 

ENTER  BUILDING  IDENTIFICATION  (EG.  '101') 
(NO  MORE  THAN  5 ALPHANUMERIC  CHARACTERS) 
7 '701' 

BUILDING  IDENTIFICATION  ENTERED  AS  '701' 
ENTER  NUMBER  OF  ROOMS  IN  BUILDING 
■>  3 


WALL  IDENTIFICATION  WALL  PARAMETERS 


DIR 

FROM 

TO 

MATERIAL 

HEIGHT 

WIDTH 

THICKNESS 

LR 

D4 

01 

M05 

2 

. 44 

4 

. 57 

1 

. 30 

LR 

D4 

01 

M06 

2 

, 44 

4 

, 57 

1 

.30 

LR 

D4 

01 

MO  4 

2 

. 44 

4 

. 57 

1 

. 30 

LR 

01 

02 

MO  6 

2 

.44 

1 

. 22 

1 

.30 

LR 

02 

D2 

M07 

2 

. 44 

1 

. 22 

20 

.30 

LR 

02 

D2 

M06 

2 , 

, 44 

1 , 

. 22 

1 

.30 

LR 

01 

03 

MO  6 

2 

. 44 

3 

. 35 

1 

. 30 

LR 

03 

D2 

M07 

2 . 

44 

3 . 

, 35 

20 

.30 

LR 

03 

D2 

M06 

2 , 

. 44 

3 , 

, 35 

1 

. 30 

FB 

D3 

01 

M06 

2 , 

00 

3 . 

. &(, 

1 

.30 

FB 

01 

D1 

M0& 

2 

. 44 

3 , 

. 66 

1 

.30 

FB 

D3 

03 

M06 

2 . 

44 

3 . 

66 

1 

.30 

FB 

03 

02 

M05 

2 , 

. 44 

3 . 

66 

1 

. 30 

FB 

03 

02 

MO  6 

2 . 

44 

3 . 

66 

1 

.30 

FB 

02 

D1 

MOi 

2 . 

. 44 

3 . 

66 

1 

. 30 

UD 

D5 

01 

M04 

4 . 

57 

3 . 

66 

1 

.30 

UD 

01 

D6 

M02 

4 . 

57 

3 . 

66 

1 

. 30 

UD 

D5 

02 

M04 

1 . 

22 

3 . 

66 

1 , 

.30 

UD 

02 

D& 

M02 

1 . 

22 

3 . 

66 

1 , 

. 30 

UD 

D5 

03 

M04 

3 . 

35 

3 . 

66 

1 , 

.30 

UD 

03 

D6 

MO  2 

3 . 

35 

3 . 

66 

1 . 

30 

DOOR  AND  WINDOW  LOCATIONS 

Ik************************** 

WALL  IDENTIFICATION 


ID 

DIRECTION 

FROM 

TO 

WB 

LR 

03 

D2 

DB 

FB 

D3 

03 

WA 

LR 

D4 

01 

DA 

LR 

D4 

0 1 

DC 

LR 

01 

02 

DC 

LR 

01 

03 

WA 

FB 

01 

D1 

WB 

FB 

02 

D1 

WA 

LR 

02 

D2 

DOOR  AND  WINDOW  PARAMETERS 


* Ht  * t 

*************************************************** 

ID 

MATERIAL 

FRAME 

HEIGHT 

WIDTH 

LAYER 

DISTANCE 

MATERIAL 

THICKNESS 

ABOVE  FLR 

= = = = 

H 

H 

II 

li 

II 

u 

II 

II 

II 

====x==x= 

S S S X s s 

3 S X B X X X : 

========== 

II 

II 

II 

II 

II 

II 

II 

II 

II 

II 

DA 

M05 

M05 

2.10 

. ?1 

5.10 

0 . 00 

DB 

M05 

MO  5 

2 . 10 

1 . 20 

5 . 10 

0 . 00 

DC 

M05 

M13 

2.10 

2.10 

1 . 30 

0.00 

WA 

MOB 

M05 

1 . 20 

. 91 

1 . 00 

.61 

WA 

M09 

M05 

1 . 20 

.91 

. 61 

. 6 1 

WB 

MOB 

Ml  3 

1 . 20 

1 . 50 

1 . 00 

.91 

WB 

MO? 

M13 

1 .20 

1 . SO 

.61 

.91 

S S = B 

II 

II 

H 

li 

n 

If 

H 

II 

It 

H 

H 

II 

11 

U 

It 

======= 

It 

II 

II 

II 

U 

II 

II 

II 

11 

II 

========== 

Figure  5.11(a).  An  output  of  the  program  MASTER  giving  room  attenuation  (in  dB)  vs.  frequency  and 
direction  of  the  incident  radiation  for  building  shown  in  figure  5.1. 
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Figure  5.11(b).  Continuation  of  figure  5.11(a). 
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6.  EXPERIMENTAL  DATA 


This  chapter  comprises  reports  on  building  attenuation  measurements  made  by  NBS  at  the  Seneca  Falls 
Army  Depot,  the  Sierra  Army  Depot,  and  the  Naval  Training  Equipment  Center. 

6.1  Sierra  and  Seneca  Falls  Army  Depots 

Equipment  and  personnel  were  assembled  to  make  measurements  of  electromagnetic  attenuation  of  three 
buildings  at  two  sites  selected  by  the  Army.  These  sites  were  the  Sierra  Army  Depot  in  Herlong,  Califor- 
nia, and  the  Seneca  Army  Depot  in  Seneca  Falls,  New  York.  The  measurements  were  made  according  to  the 
Draft  Test  Plan  shown  in  Appendix  9.1,  and  are  briefly  described  here.  The  test  plan  was  modified  for 
each  test  site  by  the  engineers  in  charge  to  conform  to  any  time  constraints  and  to  any  constraints 
imposed  by  the  physical  layout  of  the  structures.  For  example,  the  frequency  range  was  reduced  from 
180  kHz  - 18  GHz  to  200  kHz  - 10  GHz  because  it  was  decided  that  the  additional  expense  involved  was  not 
justified  by  the  present  needs  of  the  Army.  Although  the  draft  test  plan  recommends  four  physical  group 
measurements,  on  the  judgment  of  the  engineers  in  charge,  three  (or  in  some  cases,  two)  groups  were  as- 
sumed sufficient  to  determine  the  shielding  effectiveness  of  the  buildings. 

The  measurements  were  conducted  over  the  frequency  range  of  200  kHz  through  10  GHz.  The  building 
(No.  672)  measured  at  the  Sierra  Army  Depot  was  constructed  of  concrete  with  a metal  barrier  inside  the 
wall.  Two  buildings  were  measured  at  the  Seneca  Falls  Army  Depot.  One  (No.  816)  was  a concrete  building 
with  one  meter  of  dirt  covering  the  side  of  the  building  and  massive  steel  doors  on  the  ends.  The  second 
building  (No.  819)  was  constructed  with  cement  blocks  and  metal  doors  for  access. 

The  technique  for  all  the  measurements  was  as  follows:  a transmitting  antenna  was  placed  30  meters 
from  the  building  with  the  transmitted  energy  being  directed  perpendicular  to  the  wall  of  the  building. 

To  get  a base  unattenuated  signal  the  receiving  system  measured  the  transmitted  signal  outside  the  build- 
ing at  the  designated  frequency.  The  same  receiving  system  was  then  used  inside  the  building  to  measure 
the  signal  attenuation  of  the  building.  This  signal  attenuation  (signal  inside  divided  by  signal  outside, 
in  dB)  was  measured  on  a predetermined  distance  grid  within  the  building.  Wherever  possible,  a \/4  (one- 
quarter  wavelength)  offset  measurement  was  made  to  detect  the  possibilities  of  building  resonance  effects. 
The  receiving  system  used  to  measure  these  building  attenuations  was  the  isotropic  antenna  system  devel- 
oped at  the  National  Bureau  of  Standards. 

The  attenuation  measurements  are  summarized  in  tables  6.1  - 6.4  and  are  plotted  in  figures  6.1,  6.2, 

6.2  and  6.4.  The  dimensions  and  physical  layouts  of  the  buildings  are  shown  in  figures  6.5,  6.6  and  6.7. 
The  tables  list  the  locations,  the  frequencies  of  the  test,  the  mean  values  of  attenuation  measured,  and 
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uncertainties  of  the  measurement  (one  standard  deviation)  shown  in  parentheses.  Computation  of  the  stan- 
dard deviation  is  treated  in  Appendix  9.1. 

6.2  Naval  Training  Equipment  Center  (NTEC) 

Measurements  were  made  of  electromagnetic  attenuation  of  three  shelters  connected  together  as  a 
training  module.  The  test  site  was  located  at  NTEC  in  Orlando,  Florida.  The  measurements  were  made  ac- 
cording to  the  test  plan  shown  in  Appendix  9.1  and  are  briefly  described  here.  The  test  plan  was  modified 
at  the  test  site  by  the  engineers  in  charge  to  conform  to  any  constraints  imposed  by  time  or  by  the  physi- 
cal layout  of  the  test  areas. 

The  measurements  were  conducted  over  the  frequency  range  of  35  MHz  up  to  18  GHz.  As  shown  in  fig- 
ure 6.8,  two  ground  level  transmitter  locations  (labeled  1 and  2)  were  used.  A third  location,  with  the 
transmitter  placed  on  the  roof  of  an  adjacent  building,  was  used  to  simulate  transmissions  from  above. 

The  following  procedure  was  used  for  all  measurements.  The  transmitter  was  placed  at  one  of  the  locations 
and  was  set  to  operate  at  the  desired  frequency  and  power  level  listed  in  the  test  plan.  The  receiving 
antenna  was  then  placed  5 meters  outside  the  building  to  measure  a reference  field  strength.  The  receiv- 
ing antenna  was  then  placed  inside  Room  1 at  the  various  locations  shown  in  the  test  plan  for  the  particu- 
lar frequency.  The  attenuation  (in  dB)  was  then  calculated  as  the  measured  field  strength  inside  divided 
by  the  measured  reference  field  strength  outside.  In  all  cases,  the  receiver  electronics  were  located  in 
Room  2 and  were  connected  to  the  antennas  with  electrical  cables. 

The  measured  data  is  shown  in  tables  6.5  - 6.7  listed  by  location.  The  attenuation  data  is  listed  as 
"average",  "high",  and  "low"  values  for  each  data  point.  The  first  label  represents  the  average  of  all 
the  data  for  that  location,  polarization,  frequency,  and  type  of  field  (magnetic  or  electric),  while  the 
other  labels  represent  the  highest  and  lowest  value  recorded. 

Figures  6.9  - 6.12  show  plots  of  the  data  where  the  circles  represent  electric  field  attenuation, 
while  the  squares  represent  magnetic  field  attenuation.  The  high  and  low  values  listed  in  the  tables  are 
shown  as  horizontal  bars  above  and  below  each  circle  or  square.  When  it  would  be  overlapped  by  the  size 
of  the  circle  or  square,  the  horizontal  bar  is  not  shown. 
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Table  6.1. 

EM  Attenuation  of  Building  No.  672 

at  Sierra  Army  Depot 

Frequency 

Building  Attenuation*,  dB 

Mz 

Electric 

: Field 

Magnetic  Field 

0.2 

36 

(2) 

24  (3) 

4 

34 

(5) 

33  (2) 

14 

27 

(4) 

28 

33 

(4) 

50 

39 

(6) 

140 

37 

(5) 

200 

27 

(4) 

401 

22 

(4) 

751 

29 

(3) 

998 

28 

(3) 

1008 

27 

(4) 

2000 

26 

(5) 

4008 

39 

(5) 

8007 

34 

(3) 

*Uncertainties  representing  one  standard  deviation  are  shown  in  parentheses. 


Table  6.2.  EM  Attenuation 

of  Building  No.  816,  End  Wall  at  Seneca  Falls,  New  York 

Frequency 

Building  Attenuation*,  dB 

MHz 

Electric  Field 

Magnetic  Field 

0.2 

46  (6) 

33  (14) 

4 

54  (7) 

15 

57  (7) 

30 

51  (8) 

50 

33  (7) 

100 

44  (5) 

200 

44  (5) 

400 

48  (13) 

750 

50  (6) 

1000 

45  (7) 

2000 

45  (7) 

4000 

42  (5) 

8000 

55  (8) 

*Uncertainties  representing 

one  standard  deviation  are 

shown  in  parentheses. 

Table  6.3.  EM  Attenuation 

of  Building  No.  816,  Side  Wall  at  Seneca  Falls,  New  York 

Frequency 

Building  Attenuation*,  dB 

MHz 

Electric  Field 

Magnetic  Field 

0.2 

56  (2) 

50  (9) 

4 

49  (2) 

15 

53  (4) 

30 

62  (4) 

50 

60  (5) 

100 

56  (7) 

500 

65  (12) 

1000 

63  (7) 

8000 

> 83t 

10,000 

> 83t 

*Uncertainties  representing 

one  standard  deviation  are 

shown  in  parentheses. 

tNo  measurable  signal  levels  with  available  equipment. 
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Table  6.4.  EM  Attenuation  of  Building  No.  819,  End  Wall  at  Seneca  Falls,  New  York 


Frequency 

Building  Attenuation*,  dB 

MHz 

Electric  Field 

Magnetic  Field 

0.2 

21  (3) 

24  (4) 

4 

18  (7) 

16  (5) 

15 

16  (2) 

30 

19  (4) 

50 

4 (4) 

100 

10  (7) 

200 

13  (7) 

500 

13  (4) 

750 

14  (3) 

1000 

23  (4) 

4000 

24  (4) 

8000 

34  (18) 

10,000 

35  (3) 

*Uncertainties  representing  one  standard  deviation  are  shown  in  parentheses. 


Table  6.5.  Attenuation  measured  with  launch  antenna  at  location  1,  NTEC 


Vertical 

Polarization 

Horizontal 

Polarization 

Frequency 

Electric  Field 

Magnetic  Field 

Electric  Field 

GHz 

Attenuation 

(dB) 

Attenuation  (dB) 

Attenuation 

(dB) 

Average 

High 

Low 

Average 

High  Low 

Average 

High 

Low 

0.0035 

-34 

-43 

-25 

-38 

-43  -34 

0.007 

-23 

-29 

-18 

-27 

-33  -21 

0.014 

-42 

-42 

-41 

-45 

-46  -44 

0.028 

-43 

-49 

-37 

-43 

-46  -40 

0.054 

-26 

-26 

-26 

0.088 

-17 

-18 

-15 

0.14 

-15 

-16 

-13 

-16 

-18 

-14 

0.20 

-19 

-21 

-16 

-13 

-15 

-11 

0.40 

-23 

-25 

-18 

-10 

-15 

- 5 

0.75 

-20 

-23 

-19 

-31 

-31 

-30 

1.0 

-10 

-16 

- 0 

-10 

-13 

- 7 

2.0 

- 7 

- 8 

- 5 

- 7 

- 8 

- 4 

8.0 

-37 

-38 

-35 

-23 

-26 

-20 

12.0 

18.0 

-11 

-11 

-11 

-13 

-15 

-12 
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Table  6.6.  Attenuation  measured  with  launch  antenna  at  location  2,  NTEC 


Vertical 

Polarization 

Horizontal 

Polarization 

Frequency 

Electric  Field 

Magnetic  Field 

Electric  Field 

GHz 

Attenuation 

(dB) 

Attenuation  (dB) 

Attenuation 

(dB) 

Average 

High 

Low 

Average 

High  Low 

Average 

High 

Low 

0.0035 

-22.5 

-25 

-20 

-21 

-21  -20 

0.007 

-30 

-40 

-21 

-20 

-20  -19 

0.014 

-27 

-28 

-26 

-25 

-27  -23 

0.028 

-28 

-33 

-22 

-26 

-34  -18 

0.054 

-32 

-39 

-25 

0.088 

-13 

-17 

-10 

0.14 

- 6 

- 8 

- 1 

-13 

-14 

-11 

0.20 

- 7 

-10 

- 5 

-17 

-19 

-14 

0.40 

-12 

-14 

-10 

- 7 

-11 

- 4 

0.75 

-13 

-16 

-11 

-18 

-20 

-16 

1.0 

-22 

-24 

-21 

-20 

-26 

-17 

2.0 

-31 

-34 

-27 

-22 

-26 

-19 

8.0 

-17 

-17 

-16 

-19 

-20 

-18 

12.0 

-13 

-24 

- 1 

-15 

-21 

- 9 

18.0 

Table  6.7, 

Attenuation  measured  with  launch  antenna 

at  location  3 (roof),  NTEC 

Vertical  Polarization 

Horizontal  Polarization 

Frequency 

Electric  Field 

Electric  Field 

GHz 

Attenuation  (dB) 

Attenuation  (dB) 

Average  High  Low 

Average  High  Low 

8.0 

-20  -22  -18 

-20  -22  -17 

62 


» I Ml 


■LJJlJlJlI. 


0.1 


1.0 


10 


100 


FREQUENCY,  MHz 


1 I mill 1 I I ililJ 

1,000  10,000 


Figure  6.1.  Electromagnetic  attenuation  versus  frequency  of  Building  No.  672  at  Sierra  Army 

Depot.  Electric  field  attenuation  (open  circles)  was  measured  from  0.2  - 10,000  MHz 
while  magnetic  field  (boxes)  was  measured  at  0.2  and  4 MHz.  Error  bars  represent 
one  standard  deviation.  See  figure  6.5  for  locations  of  transmitter  and  receivers. 
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Figure  6.2.  Electromagnetic  attenuation  versus  frequency  for  Building  No.  816  at  Seneca  Falls.  The 
data  are  plotted  as  figure  6.1.  For  this  scan,  the  transmitter  was  located  at  the  "End 
Wall"  as  shown  in  figure  6.6. 
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Figure  6.3.  Electromagnetic  attenuation  versus  frequency  for  Building  No.  816  at  Seneca  Falls.  The 

data  are  plotted  as  in  figure  6.1.  For  this  scan,  the  transmitter  was  located  at  the  "Side 
Wall"  as  shown  in  figure  6.6.  Magnetic  field  attenuation  was  measured  at  0.2  MHz,  only. 
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Frequency,  MHz 


Figure  6.4.  Electromagnetic  attenuation  versus  frequency  for  Building  No.  819  at  Seneca  Falls. 

The  data  are  plotted  the  same  as  in  figure  6.1.  The  transmitter  and  receiver 
locations  are  shown  in  figure  6.7.  Magnetic  field  attenuation  was  measured  at 
0.2  and  4 MHz. 


66 


67  m 


Figure  6. 


o Reference  Field 
X Inside  Field 


SIERRA  ARMY  DEPOT, 
BUILDING  672 


Transmitter 


5.  Physical  layout  of  Building  No.  672  at  Sierra  Army  Depot.  The  transmitter  is  located 

30  meters  from  the  building  and  is  shown  as  a square  box.  Outside  reference  fields  wc-re 
measured  15  meters  from  the  building  at  the  locations  marked  with  open  circles.  One  row 
and  one  column  of  inside  measurements  were  made  at  the  locations  marked  by  two  dashed  . 
with  x's.  Measurements  are  made  at  one  meter  intervals  along  the  dashed  line. 
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at  End  Wall 


Figure  6.6.  Physical  layout  of  Building  No.  816  at  Seneca  Falls.  For  this  site,  two  sets  of  data  were 
taken  with  the  transmitter  located  at  the  two  boxes  marked  on  the  drawing.  Reference, 
outside  measurements  were  taken  at  the  locations  marked  with  open  circles  while  inside 
measurements  were  taken  along  the  dashed  line.  For  the  end  wall  transmitter  location, 
inside  measurements  were  taken  at  the  locations  marked  with  x's;  while  the  side  wall  trans- 
mitter measurements  are  marked  with  closed  circles.  Measurements  are  made  at  one  meter 
intervals  along  the  dashed  lines. 
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Figure  6.7. 


Physical  layout  of  Building  No.  819  at  Seneca  Falls.  The  transmitter  is  located  at  the 
solid  box  marked  on  the  drawing,  while  the  outside  reference  points  are  shown  as  open  cir- 
cles. The  inside  measurement  points  are  located  along  the  dashed  lines  with  the  x's 
marked.  Measurements  are  made  at  one  meter  intervals  along  the  dashed  lines. 
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Figure  6.8. 
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Building  layout  of  training  module  at  NTEC.  The  physical  arrangement  of  the  three  attached 
buildings  are  shown  along  with  the  two  transmitter  locations  (boxes).  Air  conditioning 
units  are  labeled  "A.C.".  A rubber  shroud  or  gasket  is  used  to  attach  the  rooms  together. 
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FREQUENCY.  GHz 


Figure  6.9.  Building  attenuation  versus  frequency  of  training  module  at  NTEC.  This  graph  shows  the 

data  for  transmitter  location  1 with  vertical  polarization  launched.  The  circles  represent 
average  electric  field  attenuation,  while  the  average  magnetic  field  attenuation  is  shown 
as  a square.  The  limit  bars  represent  the  highest  and  lowest  attenuation  observed  at  each 
frequency. 
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Figure  6.10.  Building  attenuation  versus  frequency  of  training  module  at  NTEC.  This  graph  shows  the 
data  for  transmitter  location  1 with  horizontal  polarization  launched.  The  circles  re- 
present the  average  electric  field  attenuation,  while  the  limit  bars  represent  the  highest 
and  lowest  attenuations  observed  at  each  frequency. 
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FREQUENCY,  GHz 


Figure  6.11.  Building  attenuation  versus  frequency  of  training  module  at  NTEC.  This  graph  shows  the 

data  for  transmitter  location  2 with  vertical  polarization  launched.  The  circles  represent 
average  electric  field  attenuation,  while  the  average  magnetic  field  attenuation  is  shown 
as  a square.  The  limit  bars  represent  the  highest  and  lowest  attenuations  observed  at  each 
frequency. 


73 


FREQUENCY.  GHz 


Figure  6.12.  Building  attenuation  versus  frequency  of  training  module  at  NTEC.  This  graph  shows  the 
data  for  transmitter  location  2 with  horizontal  polarization  launched.  The  circles  re- 
present the  average  electric  field  attenuation,  while  the  limit  bars  represent  the  highest 
and  lowest  attenuation  observed  at  each  frequency. 
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7.  COMPUTER  RESULTS  AND  CONCLUSIONS 


7.1  Comparison  With  Experimental  Results 

To  test  the  validity  of  the  computer  calculation  of  building  attenuation,  the  program  was  run  for  a 
building  that  had  been  measured  experimentally  for  electromagnetic  shielding  effectiveness.  The  struc- 
ture chosen  for  comparison  was  the  training  module  located  at  the  Naval  Training  Equipment  Center  (NTEC) 
in  Orlando,  Florida.  The  experimental  measurements  of  shielding  effectiveness  are  already  described  in 
Section  6.2  of  this  report. 

To  input  data  into  the  computer  program,  the  training  module  floor  plan  shown  in  figure  6.8,  wa 
redrawn,  as  shown  in  figure  7.1,  to  show  the  details  of  the  walls,  windows,  and  doors,  based  on  observa- 
tions made  at  the  measurement  site.  Some  assumptions  and  compromises  were  also  made  so  that  the  building 
could  be  properly  modelled  by  the  computer.  Looking  at  figure  6.8,  the  main  questions  were;  1)  how  to 
account  for  the  rubber  gaskets  between  the  modules.  The  first  question  was  solved  by  considering  the 
open  space  between  the  modules  as  a fourth  room,  or  room  4 as  shown  on  figure  7.1.  The  walls  were  taken 
as  M01  ("NULL  MATERIAL")  and  windows  of  material  M01  with  a metal  frame  (M12  (STEEL))  were  added  on  the 
three  ends  of  the  room.  The  "T"  shape  of  ROOM  04  was  created  by  using  two  rectangular  shaped  volumes  and 
giving  them  the  same  name.  For  example,  look  at  the  last  two  data  entry  lines  of  the  first  table  in 
figure  7.2(a)  and  notice  that  room  4 has  two  ceiling  sections,  one  with  dimensions  6.10  x 1.22  m and  the 
second  with  6.10  x 0.15  m.  The  three  windows,  DA,  DB  and  DB,  shown  in  the  figure  were  added  so  that  the 
input  resonance  condition  described  in  Section  3.5  would  be  taken  into  account. 

The  air  conditioners  (question  2)  were  considered  closed  doors  in  the  model  ("DC"  on  the  diagram). 

The  rubber  gaskets  (question  3)  were  modelled  by  ignoring  them.  They  should  have  no  shielding  effective- 
ness for  electromagnetic  radiation. 

When  the  experimental  measurements  were  made  on  the  shelter,  some  of  the  exterior  doors  were  left 
open  to  provide  ventilation  for  the  equipment  from  the  hot  and  humid  conditions.  Those  doors,  marked 

"DO"  in  figure  7.1,  are  modelled  as  "open"  for  the  computer  program  so  that  the  calculations  can  be 

properly  compared  with  the  experimental  results.  (Experimentally  it  was  found  that  opening  the  doors  had 
less  than  a 2 dB  effect  on  the  measurements.  Since  equipment  failure  was  experienced  with  the  doors 
closed,  and  since  the  experimental  uncertainty  was  typically  greater  than  2 dB,  the  engineers  in  charge 
of  the  measurement  made  the  decision  to  leave  those  doors  open.) 

The  computer  print-out  for  the  calculation  is  shown  in  figure  7.2  (a-d).  The  first  three  tables 
list  the  wall  data  file  B204W,  the  hole  data  file  B204H,  and  hole  types  data  file  B204T.  The  next 
thirteen  tables  list  the  attenuation  of  each  room  (1-4)  for  each  direction  of  input  (1-5)  for  frequencies 
in  the  range  of  1.0  MHz  to  10  GHz.  In  figures  7. 3-7. 6,  the  experimental  data  (open  circles  and  squares) 
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is  compared  to  the  calculated  data  (closed  triangles)  where  transmitter  location  1 corresponds  to  com- 
puter direction  Dl,  and  transmitter  location  2 corresponds  to  computer  direction  D2.  Since  experimental 
measurements  were  made  only  for  room  1,  the  calculated  data  is  displayed  for  just  room  1. 

By  symmetry,  a field  projected  from  direction  D3  should  yield  identical  results  with  a field  pro- 
jected from  Dl.  This  is  evident  in  the  attenuation  tables  of  figure  7.2  (a-d)  where  the  column 
corresponding  to  D3  is  identical  with  the  results  shown  in  the  first  column,  Dl.  The  fourth  column,  D4, 
is  -60  dB  at  all  frequencies  and  for  all  rooms.  This  is  caused  by  the  fact  that  the  wall  facing  direc- 
tion D4  has  no  openings  which  will  allow  penetration.  Since  that  wall  "shadows"  all  the  other  rooms,  and 
since  the  computer  model  does  not  include  external  diffraction  around  corners,  all  of  the  rooms  will  have 
a -60  dB  attenuation  factor  for  direction  D4.  In  figure  7.7,  the  room  and  door  resonances  of  the  test 
structure  are  shown.  In  the  0.1  GHz  range  the  room  resonance  and  door  resonance  for  door  "DO"  dominate 
and  drop  the  attenuation  factor  to  zero.  (Where  the  computer  model  calculated  gain  for  a room,  the  atten 
nation  factor  was  taken  to  be  zero.)  This  effect  was  equally  strong  for  both  directions  Dl  and  D2  and 
can  be  seen  in  figures  7.3  and  7.4.  At  around  1.0  GHz,  the  dominant  resonant  effect  is  due  to  door  "DB". 
Since  this  door  is  only  illuminated  from  direction  Dl,  the  calculated  attenuation  at  1.0  GHz  is  reduced 
for  direction  Dl  (fig.  7.3)  but  not  for  direction  D2  (fig.  7.4).  This  is  in  good  agreement  with  the 
corresponding  experimental  measurements  for  those  directions. 

Overall,  the  fit  between  the  calculated  and  experimental  results  are  in  good  agreement.  Given  just 
the  calculated  data,  it  would  be  possible  to  estimate  the  shielding  effectiveness  of  the  training  modules 

7.2  Recommendation  for  Further  Work 

One  area  in  the  model  that  could  use  further  development  is  in  the  resonance  calculations.  The 
present  approach  essentially  turns  the  resonances  "on"  or  "off"  and  does  not  use  any  sophisticated  tech- 
niques to  properly  weight  the  resonant  effects.  It  should  be  possible  to  incorporate  more  advanced 
resonant  models  into  the  program.  That  task  should  be  addressed  in  future  work. 
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DIRECTION  D1 


Figure  7.1.  Building  layout  of  training  modules  used  for  comparison  of  calculated  versus  experimental 
data.  Notice  that  the  air  gap  between  the  modules  is  considered  "Room  04"  for  the 
computer  model. 
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Figure  7.2(a).  Computer  print-out  of  calculations  of  electromagnetic  shielding  effectiveness  for  building 
shown  in  figure  7.1. 
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Figure  7.2(b).  Computer  print-out  of  calculations  of  electromagnetic  shielding  effectiveness  for  building 
shown  in  figure  7.1. 
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Figure  7.2(c).  Computer  print-out  of  calculations  of  electromagnetic  shielding  effectiveness  for  building 
shown  in  figure  7.1. 
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Figure  7.2(d).  Computer  print-out  of  calculations  of  electromagnetic  shielding  effectiveness  for  building 
shown  in  figure  7.1. 
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.001  .01  .1  1 10  100 


FREQUENCY,  GHz 

FIGURE  7.3  TRANSMITTER  LOCATION  1,  VERTICAL  POLARIZATION  DATA 


Ui ^ I 

.001  .01  .1  1 10  100 


FREQUENCY,  GHz 

FIGURE  7.4  TRANSMITTER  LOCATION  2,  VERTICAL  POLARIZATION  DATA 
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.001  .01  .1  1 10 

FREQUENCY,  GHz 

FIGURE  7.5  TRANSMITTER  LOCATION  1,  HORIZONTAL  POLARIZATION  DATA 
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FREQUENCY,  GHz 

FIGURE  7.7  TEST  STRUCTURE  ROOM  AND  DOOR  RESONANCES 
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APPENDIX  9.1 


TEST  PLAN 

BUILDING  ATTENUATION  MEASUREMENTS 

A.l  Purpose 

This  plan  outlines  a method  for  measuring  the  attenuation  of  buildings  over  all  or  part  of  the  fre- 
quency range  covered  in  this  report:  10  kHz  - 10  GHz.  In  order  to  compare  measured  attenuation  data  with 
computed  data  (generated  by  the  computer  program  developed  for  this  report),  the  building  must  be  square 
or  rectangular,  or  made  up  of  adjoining  squares  or  rectangles;  and  the  test  signals  must  be  perpendicu- 
larly incident  on  the  building  walls. 

A. 2 Frequency  Coverage 

Apart  from  limitations  imposed  by  the  availability  of  portable  sources  and  launching  antennas,  the 
choice  of  measurement  frequencies  may  be  determined  by  factors  such  as 

• regions  of  low  attenuation  in  the  computed  data. 

• the  frequencies  of  strong  ambient  signals. 

• frequencies  at  which  a given  device  is  known  to  have  highest  susceptibility. 

If  there  are  not  worrisome  frequencies,  the  project  engineer  can  make  the  choice  of  measurement  frequen- 
cies over  the  10  kHz  - 10  GHz  range. 

Table  A-1  lists  the  frequencies  at  which  an  NBS  team  made  building  attenuation  measurements  on  an 
Army  installation.  Other  columns  in  the  table  indicate  distance  increments  between  locations  on  the 
measurement  grid,  the  type  of  field  to  be  measured  and  the  type  to  be  launched,  and  the  electric  field 
polarization.  A measurement  grid  is  shown  in  figure  A.l  for  a single-room  building  or  for  a single  room 
within  a building,  though  the  size,  shape,  and  construction  of  a particular  building  may  permit  it  to  be 
characterized  by  many  fewer  measurement  locations  (see  section  A. 3). 

A. 3 Number  and  location  of  measurements 

A. 3.1  For  a free-standing,  rectangular  building  with  a single  room,  a field  will  be  launched  perpendicu- 
lar to  all  four  faces  of  the  building  in  turn.  Where  many  rooms  exist,  only  some  of  which  are  of  inter- 
est, or  the  general  building  geometry  dictates,  some  of  the  four  faces  may  not  be  used. 

A. 3.2  The  exact  pattern  of  measurement  location  is  determined  by  the  frequency  and  is  adaptive.  (Ref. 
figure  A.l). 
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Table  A.l.  Tabulation  of  the  frequencies  and  signal  properties 
for  a set  of  electromagnetic  field  attenuation  measurements. 


Frequency  A,  Meters^, ^ Type  of  Measurement  Field  Launched 


Polarization^ 


180  kHz 

8 

E & H 

Primarily  H 

Ve 

3.5  MHz 

8 

E & H 

E X H 

7 MHz 

4 

E 

E X H 

14  MHz 

4 

E 

E X H 

28  MHz 

2 

E 

E X H 

54  MHz 

2 

E 

E X H 

140  MHz 

1* 

E 

E X H 

200  MHz 

1* 

E 

E X H 

400  MHz 

1* 

E 

E X H 

750  MHz 

1* 

E 

E X H 

1000  MHz 

1* 

E 

E X H 

Circula 

2000  MHz 

1* 

E 

E X H 

4000  MHz 

1* 

E 

E X H 

8000  MHz 

1* 

E 

E X H 

12000  MHz 

1* 

E 

E X H 

18000  MHz 

1* 

E 

E X H 

Kotes 

* Actual  position  will  be  varied 
± 1/4  meter  to  achieve  highest  reading. 

A is  spacing  of  locations  for  sequence  3 and  above. 

Circular  polarization  will  be  used  above  1 GHz  if  adequate  signals 
are  received  inside  building. 

If  signal  levels  are  too  low  a high  gain  horizontally  polarized  launching 
antenna  will  be  used. 


A. 3. 2.1  First,  the  incident  field  is  measured  5 meters  from  the  face  of  the  building  at  three  locations 
as  indicated. 

A. 3. 2. 2 Next,  a 1 meter  by  1 meter  grid  is  established  in  the  area  to  be  measured 
inside  the  front  wall  is  measured  every  meter  to  within  2 meters  of  the  side  walls 
sequence  A. 

A. 3. 2. 3 The  highest  reading  is  noted  and  a line  of  points  A meters  apart  (see  Table  A.l),  perpendicular 
to  the  first  line  is  measured,  until  a total-field  measurement  is  obtained  which  is  equal  to  or  less  than 
the  lowest  reading  obtained  in  sequence  A.  This  will  be  called  sequence  B.  Note,  however,  if  this  line 
of  measurements  is  within  ± 3 meters  of  the  center  line  of  the  building,  this  sequence  may  be  eliminated. 

A. 3. 2. 4 A line  of  points  A meters  apart  is  now  measured  along  the  center  line  of  the  building  to  the 
center  of  the  room.  This  is  called  sequence  C. 

A. 3. 2. 5 If  no  other  faces  of  the  building  are  to  be  excited  which  are  perpendicular  to  the  first  face, 
then  a last  sequence  D across  the  middle  of  the  room  will  be  taken  at  spacings  of  A meters. 


A line,  two  meters 
This  will  be  called 
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A. 3. 2. 6 If  L/A  or  W/A  £ 5,  (where  L & W are  dimensions  of  the  room  being  measured)  then  at  least  5 meas- 
urement points  will  be  taken  in  sequences  B,  C,  and  D.  The  nearest  full  meter  value  for  A will  be  chosen 
which  will  result  in  at  least  5 measurement  points  within  the  room's  dimensions. 

A. 3. 2. 7 All  readings  will  be  taken  at  a height  of  1.5  meters  except  those  at  140  MHz  when  a second  set 

will  be  taken  at  a height  of  1 meter. 

A. 3. 2. 8 Data  will  be  recorded  for  the  X,  Y,  and  Z orthogonal  components,  plus  the  equivalent  vector  sum. 

A. 3. 3 In  buildings  with  a large  door  opening,  data  will  also  be  taken  with  the  door  open  at  the  frequen- 
cy where  the  vertical  dimension  of  the  opening  is  A/2,  and  at  7 MHz,  400  MHz,  and  4 GHz. 

Again,  we  emphasize  that  the  test  plan  may  be  modified  for  each  test  site  by  the  engineers  in  charge 

to  conform  to  any  constraints  imposed  by  time  or  the  physical  layout  of  the  structure.  Although  the  test 
plan  recommends  that  measurements  be  grouped  in  four  locations  (fig.  A.l),  the  engineers  in  charge  may 
decide  that  three  (or  in  some  cases,  two)  groups  are  sufficient  to  determine  the  shielding  effectiveness 
of  the  buildings. 

A. 4 Data  Presentation 

Attenuation  measurements  can  be  summarized  in  tables  and  also  plotted.  The  table  for  each  building, 
room,  and  transmitter  location  can  list  the  frequencies  of  the  test,  the  mean  values  of  attenuation  meas- 
ured, and  uncertainties  of  the  measurement  (one  standard  deviation)  shown  in  parentheses.  The  mean  value 
of  attenuation  is  determined^  by  averaging  all  grid  point  measurements  in  a particular  building  or  room, 
for  a particular  frequency  for  each  transmitter  location: 

X = i I X. 

N 1 

where  X is  the  sample  mean,  N is  the  number  of  grid  points  measured,  and  x^  represents  the  individual 
attenuations  at  each  measured  grid  point.  The  standard  deviation  is  defined  as  the  square  root  of  the 
sample  variance: 

a = 

where 

s2  = ^I(x.-X)2 

and  where  CT  is  the  standard  deviation,  s^  is  the  sample  variance,  and  x^  and  X are  already  defined.  The 
graphs  show  the  mean  attenuation  at  each  measurement  frequency,  with  the  one-standard-deviation  limits  as 
error  bars. 
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Appendix  9.2  Listing  of  Computer  Program  SMATDB 
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FTN  3 U552  83/12/24.  09.48.08  PAGE  1 

PROGRAM  SMATDB  74/175  OPT=0 

1 PROGRAM  SMATDB  SMATDB  1 

2 C*»  INPUT  MATERIAL  ATTENUATION  AND  REFLECTION  COEFFICIENT  INTO  SMATDB  2 

3 C*«  ARRAYS  AND  THEN  STORE  DATA  IN  A PERMANENT  FILE*  SMATDB  3 

4 **  SMATDB  4 

3 *****t«**«*»*«*«******«it********«*«********«*********«*««*****«*****«*tt*c OMM  1 

4 »»•  COMMON  FOR  DATABASE  OF  MATERIAL  PROPERTIES  ***COMM  2 

7 «<t*<i****)i****«*****it*ft**********it********iik*****«i*tk******itit*A******it*)t*  * COMM  3 

8 INTEGER  MMAX  COMM  4 

V PARAMETER  (MMAX=100)  COMM  5 

10  COMMON  /MATN/  MATTENIMMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX),  QR(MMAX),  COMM  4 

11  $ MFREQ(MMAX, 7) , MERR , MTOT  COMM  7 

12  COMMON  /MATC/MAT(MMAX) ,MATDESC(MMAX)  COMM  8 


13 

INTEGER  MTOT,  MERR 

COMM 

9 

14 

REAL  MATTEN,  MRCOEF,  MFREQ,  QA , OR 

COMM 

10 

15 

CHARACTER  » 3 MAT 

COMM 

11 

18 

CHARACTER  * 70  MATDESC 

COMM 

12 

17 

t«*«t«ft*t*ftftt***«********«ft**ft*«**««*ft**«*«**««***«*ftft«t*****««**««t*ftt  * * COMM 

13 

18 

ft«*«*««**1tll«**««***********«***«««***ft*ft***«*ft*ft«**ft*«*ft*«*1McA**t**«ftft  * * COMM 

14 

19 

INTEGER  R,C,  COMMAND 

SMATDB 

8 

20 

CHARACTER  * 3 MATID 

SMATDB 

7 

21 

c» 

INITIALIZE  ARRAYS 

SMATDB 

8 

22 

DATA  MAT  / 100  * ' ' / 

SMATDB 

9 

23 

DATA  MATDESC  / 100  * ' 

' / 

SMATDB 

10 

24 

DATA  MFREQ  / 700  * 0.0  / 

SMATDB 

1 1 

25 

DATA  MATTEN  / 700  * 0.0  / 

SMATDB 

12 

28 

DATA  QA  / 100  * 0.0  / 

SMATDB 

13 

27 

DATA  MRCOEF  / 700  * 0.0  / 

SMATDB 

14 

28 

DATA  QR  / 100  * 0.0  / 

SMATDB 

15 

29 

C» 

ENTER  COMMANDS 

SMATDB 

18 

30 

PRINT  * , ' ( 1 ) CREATE  NEW 

DATABASE  (2)  ADD  TO  EXISTING  DATA  ', 

SMATDB 

17 

31 

Z 'BASE' 

SMATDB 

18 

32 

READ  *,  COMMAND 

SMATDB 

19 

33 

IF  (COMMAND  . EQ . 2)  THEN 

SMATDB 

20 

34 

CALL  LMATTER 

SMATDB 

21 

35 

IF  (MERR  .NE.  0)  CALL 

ERROR! 5) 

SMATDB 

22 

38 

END  IF 

SMATDB 

23 

37 

10 

PRINT*, '(1)  NEXT  DATA  ENTRY  (2)  CHANGE  (3>  DISPLAY  (4)  ABORT' 

, SMATDB 

24 

38 

S ' (5)  QUIT' 

SMATDB 

25 

39 

READ  *,  COMMAND 

SMATDB 

28 

40 

PRINT  * 

SMATDB 

27 

41 

IF  (COMMAND  .EQ.  1>  THEN 

SMATDB 

28 

42 

CALL  NEXT 

SMATDB 

29 

43 

ELSE  IF  (COMMAND  .EQ.  2 ) 

THEN 

SMATDB 

30 

44 

CALL  CHANGE 

SMATDB 

31 

45 

ELSE  IF  (COMMAND  .EQ.  3 ) 

THEN 

SMATDB 

32 

48 

CALL  DISPLAY 

SMATDB 

33 

47 

ELSE  IF  (COMMAND  . EQ . 4 ) 

THEN 

SMATDB 

34 

48 

PRINT* 

SMATDB 

35 

49 

PRINT* , 'PROGRAM  ABORTED 

AT  YOUR  REQEST' 

SMATDB 

38 

SO 

PRINT* 

SMATDB 

37 

51 

STOP 

SMATDB 

38 

52 

ELSE  IF  (COMMAND  .EQ.  5 > 

THEN 

SMATDB 

39 

S3 

CALL  QUIT 

SMATDB 

40 

54 

STOP 

SMATDB 

41 

55 

END  IF 

SMATDB 

42 

58 

GOTO  10 

SMATDB 

43 

57 

END 

SMATDB 

44 
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PROGRAM  SMATDB  74/175  OPT=0 


-VARIABLE  MAP--(LO=A) 


NAME--- 

ADDRESS- 

-BLOCK--- 

--PROPERTIES 

TYPE- 

---SIZE 

C 

NONE 

UNUSED/»S* 

INTEGER 

COMMAND 

157B 

INTEGER 

MAT 

OB 

/MATC/ 

CHAR* 3 

100 

MATDESC 

36B 

/MATC/ 

CHAR*70 

100 

MAT  ID 

NONE 

UNUSED/»S» 

CHAR* 3 

MATTEN 

OB 

/MATN/ 

REAL 

700 

MERR 

4374B 

/MATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

700 

MRCOEF 

1 274B 

/MATN/ 

REAL 

700 

MTOT 

4375B 

/MATN/ 

INTEGER 

QA 

2570B 

/MATN/ 

REAL 

100 

OR 

2734B 

/MATN/ 

REAL 

100 

R 

NONE 

UNUSED/»S* 

INTEGER 

-SYMBOLIC  CONSTANTS-- (LO=A) 


-NAME TYPE- VALUE 

MMAX  INTEGER  100 


-PROCEDURES--(LO=A) 
-NAME TYPE 

ARGS 

--CLASS 

-NAME 

--TYPE 

ARGS--- 

---CLASS 

CHANGE 

0 

SUBROUTINE 

LMATTER 

0 

SUBROUTINE 

DISPLAY 

0 

SUBROUTINE 

NEXT 

0 

SUBROUTINE 

ERROR 

1 

SUBROUTINE 

QUIT 

0 

SUBROUTINE 

-STATEMENT  LABELS-- 

(LO=A) 

-LABEL-ADDRESS 

PROPERTIES-- 

--DEF 

10  24B 

37 

-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS--ARGS 

SMATDB  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

160B 

= 112 

CM  LABELLED  COMMON  LENGTH 

5730B 

= 3032 

CM  STORAGE  USED 

61000B 

= 25088 

COMPILE  TIME 

0.081 

SECONDS 

92 


1 5 U 

552 

83  / 1 2 / 24  . 09  .48.06  PACE  3 

IROUTI 

NE  NE 

XT  74/175  OPT=0 

1 

SMATDB 

45 

2 

SUBROUTINE  NEXT 

SMATDB 

46 

3 

* t * t « 

* 1 1 * 1 1 * 1 1 * * * t * t * * * 1 1 1 1 1 * * * t * t * * t * * * t It  * 1 1 * * * * 1 1 1 * 1 1 * 1 1 1 1 1 * * * * t * 1 1 * * * conn 

1 

4 

* « « 

COMMON  FOR  DATABASE  OF  MATERIAL  PROPERTIES  *»*COMM 

2 

5 

* « * II  « 

******************************************************************  *C0MM 

3 

i 

INTEGER  MMAX 

COMM 

4 

7 

PARAMETER  (MMAX=100) 

COMM 

5 

8 

COMMON  /MATN/  MATTENIMMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX),  QRIMMAX), 

COMM 

6 

9 

$ MFREQ(MMAX,7) , MERR,  MTOT 

COMM 

7 

10 

COMMON  /MATC/MAT(MMAX) .MATDESC (MMAX ) 

COMM 

8 

11 

INTEGER  MTOT,  MERR 

COMM 

9 

12 

REAL  MATTEN,  MRCOEF,  MFREQ,  QA , OR 

COMM 

10 

13 

CHARACTER  * 3 MAT 

COMM 

1 1 

14 

CHARACTER  * 70  MATDESC 

COMM 

12 

IS 

ft  « * « It 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft*  ft  *ft  COMM 

13 

U 

ft  ft  ft  ft  ft 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft*  ft  ft COMM 

14 

17 

INTEGER  R,C,  VAL,  INDEX 

SMATDB 

48 

18 

CHARACTER  * 3 MATID 

SMATDB 

49 

19 

LOGICAL  ENTERED 

SMATDB 

50 

20 

10 

PRINT  *,  ‘MATERIAL  I.D.?  (EG.  ‘‘MOS'-  OR  ‘'M12'')' 

SMATDB 

51 

21 

READ  *,  MATID 

SMATDB 

52 

22 

IF  (MATID(1:1)  .NE.  'M' ) THEN 

SMATDB 

53 

23 

PRINT  *,  ‘FIRST  CHARACTER  MUST  BE  AN  M.  TRY  AGAIN‘ 

SMATDB 

54 

24 

GOTO  10 

SMATDB 

55 

2S 

END  IF 

SMATDB 

56 

26 

C*  CHECK  IF  THIS  MATERIAL  IS  ALREADY  ENTERED 

SMATDB 

57 

27 

ENTERED  = .FALSE. 

SMATDB 

58 

28 

DO  20  R=1,MMAX 

SMATDB 

59 

29 

IF  (MAT(R)  .EQ.  MATID)  THEN 

SMATDB 

60 

30 

ENTERED  = TRUE. 

SMATDB 

61 

31 

INDEX  = R 

SMATDB 

62 

32 

END  IF 

SMATDB 

63 

33 

20 

CONTINUE 

SMATDB 

64 

34 

C*  ENTER  NEW  DATA  IF  MATERIAL  NOT  ALREADY  ENTERED 

SMATDB 

65 

35 

IF  (ENTERED)  THEN 

SMATDB 

66 

36 

PRINT  *,  ‘MATERIAL  ‘, MATID, ‘ ALREADY  ENTERED‘ 

SMATDB 

67 

37 

ELSE 

SMATDB 

68 

38 

INDEX  = VAL  ( MATID(2:3)  ) 

SMATDB 

69 

39 

PRINT  », ‘ INDEX: ‘ , INDEX 

SMATDB 

70 

40 

MAT  (INDEX)  = MATID 

SMATDB 

71 

41 

PRINT  *,  ‘ENTER  ONE  LINE  DESCRIPTION  OF  MATERIAL ‘ 

SMATDB 

72 

42 

READ  »,  MATDESC  (INDEX) 

SMATDB 

73 

43 

PRINT  *,  ‘ENTER  7 ATTENUATION  VALUES  FROM  LOW  TO  HIGH  FREQ‘ 

SMATDB 

74 

44 

READ  *,  (MATTEN(INDEX,C) , C=l,7) 

SMATDB 

75 

4S 

PRINT  *.  ‘ENTER  ATTENUATION  QUALITY  PERCENT‘ 

SMATDB 

76 

46 

READ  *,  QA  (INDEX) 

SMATDB 

77 

47 

PRINT  *,  ‘ENTER  7 REFLECTION  COEFFS  FROM  LOW  TO  HIGH  FREQ‘ 

SMATDB 

78 

48 

READ  *,  (MRCOEF( INDEX, C) , C=l,7) 

SMATDB 

79 

49 

PRINT  *,  ‘ENTER  REFLECTION  COEFICIENT  QUALITY  PERCENT‘ 

SMATDB 

80 

SO 

READ  »,  QR  (INDEX) 

SMATDB 

81 

SI 

PRINT  » 

SMATDB 

82 

S2 

END  IF 

SMATDB 

83 

S3 

RETURN 

SMATDB 

84 

54 

END 

SMATDB 

85 

—VARIABLE  MAP--(LO=A) 

-NAME---ADDRESS--BLOCK PROPERTIES TYPE SIZE 


C 

357B 

INTEGER 

ENTERED 

362B 

LOGICAL 

INDEX 

360B 

INTEGER 

NAT 

OB 

/MATC/ 

CHAR*3 

100 

MATDESC 

36B 

/MATC/ 

CHAR»70 

100 

93 


FTN  5.1+552 

83/12/24.  09.48.06  PAGE 

4 

SUBROUTINE 

NEXT 

74/175  OPT=0 

MAT  ID 

361B 

CHAR»3 

MATTEN 

OB 

/MATN/ 

REAL 

700 

MERR 

4374B 

/NATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

700 

MRCOEF 

1274B 

/MATN/ 

REAL 

700 

MTOT 

4375B 

/MATN/ 

INTEGER 

QA 

2S70B 

/MATN/ 

REAL 

100 

OR 

2734B 

/MATN/ 

REAL 

1 00 

R 

3S6B 

INTEGER 

-SYMBOLIC  CONSTANTS--! LO=A) 


-NAME TYPE VALUE 

MMAX  INTEGER  100 


-PROCEDURES--(LO=A) 

-NAME TYPE ARCS CLASS 

VAL  INTEGER  1 FUNCTION 


-STATEMENT  LABELS-- ( LO=A ) 

-LABEL- ADDRESS PROPERTIES DEF 

10  SB  20 

20  INACTIVE  DO-TERM  33 


-ENTRY  POINTS--(LO=A) 
-NAME---ADDRESS--ARGS--- 

NEYT  4B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


3i6B  = 246 

5730B  ::  3032 

61000B  = 25088 

0,117  SECONDS 


94 


FTN  3 U5S2  83/12/24.  09.48.06  PAGE  S 

SUBROUTINE  DISPLAY  74/175  OPT=0 


1 

SMATDB 

86 

2 

SMATDB 

87 

3 

SUBROUTINE  DISPLAY 

SMATDB 

88 

4 

ttt*******************************************************************  * * COMM 

1 

5 

« « « 

COMMON  FOR  DATABASE  OF  MATERIAL  PROPERTIES 

***COMM 

2 

6 

COMM 

3 

7 

INTEGER  HMAY 

COMM 

4 

8 

PARAMETER  (MMAX=100) 

COMM 

5 

9 

COMMON  /MATN/  MATTENI MMAX , 7 ) , MRCOEF <MMAX , 7 ) , QA(MMAX),  QR(MMAX),  COMM 

6 

10 

$ MFREQ(MMAX,7) , MERR , MTOT 

COMM 

7 

11 

COMMON  /MATC/MAT(MMAX) , HATDESC (MMAX ) 

COMM 

8 

12 

INTEGER  MTOT,  HERR 

COMM 

9 

13 

REAL  HATTEN,  MRCOEF,  MFREQ,  QA , OR 

COMM 

10 

14 

CHARACTER  * 3 MAT 

COMM 

11 

15 

CHARACTER  » 70  HATDESC 

COMM 

12 

16 

t******!***************************************************************  * COMM 

13 

17 

* COMM 

14 

18 

INTEGER  R,C,  COMMAND 

SMATDB 

90 

19 

CHARACTER  » 3 MATID 

SMATDB 

91 

20 

LOGICAL  FOUND 

SMATDB 

92 

21 

PRINT  *,  '<1)  ALL  MATERIALS  OR  (2)  ONE  MATERIAL- 

SMATDB 

93 

22 

READ  *,  COMMAND 

SMATDB 

94 

23 

PRINT  * 

SMATDB 

95 

24 

IF  (COMMAND  .EQ.  1)  THEN 

SMATDB 

96 

25 

PRINT  » 

SMATDB 

97 

26 

DO  10  R = l.MMAX 

SMATDB 

98 

27 

MATID  = MAT(R) 

SMATDB 

99 

28 

IF  (MATIDd  : 1)  .EQ.  'M'  ) THEN 

SMATDB 

100 

29 

PRINT  * , MAT(R) 

SMATDB 

101 

30 

PRINT  * , MATDESC  (R) 

SMATDB 

102 

31 

PRINT*,  'FREQUENCY;  ' , (MFREQ ( R , C ) , C= 1 , 7 ) 

SMATDB 

103 

32 

PRINT  * , 'ATTENUATION:  ' , (MATTEN(R , C ) , C=l,7) 

SMATDB 

104 

33 

PRINT  *, 'ATTENUATION  QUALITY  PERCENT:  ',QA(R) 

SMATDB 

105 

34 

PRINT  * , 'REFLECTION:  ' , (MRCOEF (R , C > , C=l,7) 

SMATDB 

106 

35 

PRINT  *, 'REFLECTION  COEF  QUALITY  PERCENT:  ',QR(R) 

SMATDB 

107 

36 

PRINT  * 

SMATDB 

108 

37 

END  IF 

SMATDB 

109 

38 

10 

CONTINUE 

SMATDB 

1 10 

39 

ELSE  IF  (COMMAND  . EQ . 2 ) THEN 

SMATDB 

111 

40 

PRINT  *,  'SPECIFY  ID  OF  MATERIAL  TO  BE  PRINTED  (E.Q.  M05)' 

SMATDB 

112 

41 

READ  *,  MATID 

SMATDB 

113 

42 

FOUND  = .FALSE. 

SMATDB 

114 

43 

DO  20  R = 1,MMAX 

SMATDB 

115 

44 

IF  (MAT(R)  .EQ.  MATID)  THEN 

SMATDB 

1 16 

45 

PRINT  *,  MAT(R) 

SMATDB 

117 

46 

PRINT  *,  MATDESC(R) 

SMATDB 

118 

47 

PRINT*,  'FREQUENCY:  ' , (MFREQ( R , C ) , C= 1 , 7 ) 

SMATDB 

119 

48 

PRINT  *,  'ATTENUATION:  ' , (MATTEN(R , C ) , C=l,7) 

SMATDB 

120 

49 

PRINT  *,  'ATTENUATION  QUALITY  PERCENT:  ',QA(R) 

SMATDB 

121 

SO 

PRINT  *,  'REFLECTION;  ', (MRCOEF (R , C ) , C=l,7) 

SMATDB 

122 

51 

PRINT  *,  'REFLECTION  QUALITY  PERCENT:  ',QR(R> 

SMATDB 

123 

52 

FOUND  = .TRUE. 

SMATDB 

124 

53 

END  IF 

SMATDB 

125 

54 

20 

CONTINUE 

SMATDB 

126 

55 

END  IF 

SMATDB 

127 

56 

IF  (.NOT.  FOUND)  THEN 

SMATDB 

128 

57 

PRINT  *,  'MATERIAL  ',  MATID,  ' NOT  FOUND' 

SMATDB 

129 

58 

END  IF 

SMATDB 

1 30 

59 

PRINT  * 

SMATDB 

131 

60 

RETURN 

SMATDB 

132 

61 

END 

SMATDB 

133 

95 
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SUBROUTINE  DISPLAY  74/175  OPT=0 

-VARIABLE  MAP--(LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


c 

51  IB 

INTEGER 

COMMAND 

512B 

INTEGER 

FOUND 

514B 

LOGICAL 

MAT 

OB 

/MATC/ 

CHAR*3 

100 

MATDESC 

36B 

/MATC/ 

CHAR*70 

100 

MAT  ID 

513B 

CHAR*3 

MATTEN 

OB 

/MATN/ 

REAL 

700 

MERR 

4374B 

/MATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

700 

MRCOEF 

1274B 

/MATN/ 

REAL 

700 

MTOT 

4375B 

/MATN/ 

INTEGER 

QA 

2570B 

/MATN/ 

REAL 

100 

QR 

2734B 

/MATN/ 

REAL 

100 

R 

510B 

INTEGER 

-SYMBOLIC  CONSTANTS-- (LO=A) 


-NAME TYPE VALUE 

MMAX  INTEGER  100 


-STATEMENT  LABELS-- ( LO=A) 
-LABEL-ADDRESS PROPERTIES DEP 

10  INACTIVE  DO-TERM  38 

20  INACTIVE  DO-TERM  54 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS-- ARCS- -- 

DISPLAY  4B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


S25B  = 341 

5730B  = 3032 

61000B  = 25088 

0.172  SECONDS 


96 
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7 


FTN  5 U552 
FUNCTION  VAL 


1 

SMATDB 

134 

2 

SMATDB 

135 

3 

INTEGER  FUNCTION  VAL(STRING) 

SMATDB 

136 

4 

C*»  RETURNS  THE  INTEGER  VALUE  OF  A STRING. 

SMATDB 

137 

5 

INTEGER  NUMBER,  X , L , EXP , D I G IT , GETLEN 

SMATDB 

138 

6 

CHARACTER  * (*)  STRING 

SMATDB 

139 

7 

L = GETLEN(STRING) 

SMATDB 

140 

8 

NUMBER  = 0 

SMATDB 

141 

9 

DO  10  X = L, 1 ,-l 

SMATDB 

142 

10 

EXP  = L - X 

SMATDB 

143 

1 1 

DIGIT  = ICHAR(STRING(X: X) ) - 16 

SMATDB 

144 

12 

NUMBER  = NUMBER  + D IG IT* 1 0 * * EXP 

SMATDB 

145 

13 

10  CONTINUE 

SMATDB 

146 

1 4 

VAL  = NUMBER 

SMATDB 

147 

15 

RETURN 

SMATDB 

148 

1 6 

END 

SMATDB 

149 

VARIABLE  MAP--(LO=A) 

NAME ADDRESS --BLOCK PROPERTIES 

TYPE 

---SIZE 

DIGIT 

76B 

INTEGER 

EXP 

75B 

INTEGER 

L 

74B 

INTEGER 

NUMBER 

72B 

INTEGER 

STRING 

1 DUMMY -ARG 

CHAR* ( *) 

VAL 

71B 

INTEGER 

X 

73B 

INTEGER 

-PROCEDURES 

--(LO=A) 

-NAME 

TYPE 

--ARGS--- 

---CLASS 

GETLEN 

INTEGER 

1 

FUNCTION 

ICHAR 

INTEGER 

1 

INTRINSIC 

-STATEMENT  LABELS-- ( LO=A ) 

-LAB  EL -ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERN  13 

-ENTRY  POINTS--(LO=A) 

-NAME ADDRESS --ARCS 

VAL  6B  1 


-STATISTICS-- 


PROGRAN-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


102B  = 66 

61000B  = 25088 

0.041  SECONDS 


97 
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FUNCTION  GETLEN  74/175  OPT=0 


1 

SMATDB 

150 

2 

SMATDB 

151 

3 

INTEGER  FUNCTION  GETLEN  (STRING) 

SMATDB 

152 

4 

C 

SMATDB 

153 

5 

C 

DETERMINE  LENGTH  OF  STRING  EXCLUDING  ANY  BLANK  PADDING 

SMATDB 

154 

6 

C 

SMATDB 

155 

7 

C 

SMATDB 

156 

8 

C 

ARGUMENT  DEFINITIONS  -- 

SMATDB 

157 

9 

C 

INPUT  ARGUMENTS 

SMATDB 

158 

10 

C 

STRING  - STRING  WHOSE  LENGTH  IS  TO 

BE 

DETERMINED 

SMATDB 

159 

11 

C 

SMATDB 

160 

12 

CHARACTER  * (*)  STRING 

SMATDB 

161 

13 

C 

SMATDB 

162 

14 

C 

FUNCTION  PARAMETERS 

SMATDB 

163 

15 

CHARACTER  » 1 BLANK 

SMATDB 

164 

16 

PARAMETER  (BLANK  = ‘ ') 

SMATDB 

165 

17 

C 

SMATDB 

166 

18 

C 

LOCAL  VARIABLES 

SMATDB 

167 

19 

INTEGER  NEXT 

SMATDB 

168 

20 

C 

SMATDB 

169 

21 

C 

START  WITH  THE  LAST  CHARACTER  AND  FIND 

THE 

FIRST  NON-BLANK 

SMATDB 

170 

22 

DO  10  NEXT  = LEN(STRING) , 1 ,-l 

SMATDB 

171 

23 

IF  (STRING(NEXT  ; NEXT)  .NE.  BLANK) 

THEN 

SMATDB 

172 

24 

GETLEN  = NEXT 

SMATDB 

173 

25 

RETURN 

SMATDB 

174 

26 

END  IF 

SMATDB 

1 75 

27 

10  CONTINUE 

SMATDB 

176 

28 

C 

SMATDB 

177 

29 

C 

ALL  CHARACTERS  ARE  BLANKS 

SMATDB 

178 

30 

GETLEN  = 0 

SMATDB 

179 

31 

C 

SMATDB 

180 

32 

RETURN 

SMATDB 

181 

33 

END 

SMATDB 

182 

-VARIABLE  MAP--(LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 

GETLEN  63B  INTEGER 

NEXT  64B  INTEGER 

STRING  1 DUMMY-ARG  CHAR*(*) 


-SYMBOLIC  CONSTANTS--(LO=A) 

-NAME TYPE VALUE 

BLANK  CHAR*1  ' ' 

-PROCEDURES--(LO=A) 

-NAME TYPE ARCS CLASS 

LEN  INTEGER  1 INTRINSIC 

-STATEMENT  LABELS--(LO=A) 

-LABEL-ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  27 
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FUNCTION  GETLEN  74/175  OPT=0 

--ENTRY  POINTS--(LO=A) 

-NAME ADDRESS-- ARCS 

GETLEN  6B  1 


--STATISTICS-- 

PROGRAM-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


70B  = 56 

61000B  = 25088 

0.038  SECONDS 


98 


FTN  5 U5  5 2 
SUBROUTINE  QUIT 


63  / 1 2 / 2 4 . 09.48  .06  PACE 
74/175  OPT=0 


10 


1 

2 

3 

4 « * * 

5 * » » 

( * « « 

7 


SMATDB 

SMATDB 

SUBROUTINE  QUIT  SMATDB 

*«****ii******i«i****«*«***«***«**tr**«**«*****tk*«*«)t********«t»t«*******  * * COMM 
COMMON  FOR  DATABASE  OF  MATERIAL  PROPERTIES  »**COMM 

* COMM 


INTEGER  MMAX 
PARAMETER  (MMAX=100) 


COMM 

COMM 


183 
1 84 
185 
1 
2 

3 

4 

5 


10 

i MFREQ(MMAX,7) , MERR,  MTOT 

COMM 

7 

1 1 

COMMON  /HATC/ MAT (MMAX) , MATDESC (MMAX ) 

COMM 

8 

12 

INTEGER  MTOT,  MERR 

COMM 

9 

13 

REAL  MATTEN,  MRCOEF,  MFREQ,  QA , QR 

COMM 

10 

1 4 

CHARACTER  * 3 MAT 

COMM 

11 

15 

CHARACTER  * 70  MATDESC 

COMM 

12 

U 

*t*t*«t**t*«t**t*ft*Aik**«*ft****ft*«**«**ft««*««*««*««*««*ft***jkft**t««**ft**«*c  OMM 

13 

17 

t******«**«***1tA«««*««*««*«***«*«*«A$t*ft«1l[*ft*K**ftt*****ft*««««*««ft***llt**  * * COMM 

14 

18 

INTEGER  R,C 

SMATDB 

1 87 

19 

CHARACTER  * 3 MATID 

SMATDB 

188 

20 

LOGICAL  FOUND 

SMATDB 

189 

21 

OPEN  (UNIT  =6,FILE=‘MATTER’ ,FORM=*FORMATTED' , 

SMATDB 

190 

22 

Z ACCESS= ■ SEQUENTIAL ■ , STATUS= 'NEW ) 

SMATDB 

191 

23 

REWIND  (6) 

SMATDB 

192 

24 

DO  10  R=1 ,MMAX 

SMATDB 

193 

25 

MATID  = MAT(R) 

SMATDB 

194 

26 

IF  (MATID(1:1>  . EQ . 'M'  ) THEN 

SMATDB 

1 95 

27 

WRITE  (6,100)  MAT(R) 

SMATDB 

196 

26 

WRITE  (6,200)  MATDESC  (R) 

SMATDB 

1 97 

29 

WRITE  (6,400)  lE+4,  lE+5  ,lE+6,  lE+7,  lE+8,  lE+9,  lE+10 

SMATDB 

198 

30 

WRITE  (6,400)  (MATTEN(R,C) ,C=1 ,7) 

SMATDB 

1 99 

31 

WRITE  (6,400)  QA(R) 

SMATDB 

200 

32 

WRITE  ( 6,400  ) (MRCOEF(R,C)  ,C=1  ,7) 

SMATDB 

201 

33 

WRITE  (6,400)  QR(R) 

SMATDB 

202 

34 

END  IF 

SMATDB 

203 

35 

10 

CONTINUE 

SMATDB 

204 

36 

ENDFILE  (6) 

SMATDB 

205 

37 

CALL  PF  ( 'REPLACE* ,0, 'MATTER' ) 

SMATDB 

206 

38 

CLOSE  (6,  STATUS  = 'DELETE') 

SMATDB 

207 

39 

100 

FORMAT  (A3) 

SMATDB 

208 

40 

200 

FORMAT  (A70) 

SMATDB 

209 

41 

400 

FORMAT  (7(1X,  E9.3)) 

SMATDB 

210 

42 

RETURN 

SMATDB 

2 1 1 

43 

END 

SMATDB 

212 

VARIABLE 

MAP-- 

it 

o 

NAME---ADDRESS 

--BLOCK 

--PROPERTIES 

TYPE 

---SIZE 

C 

270B 

INTEGER 

FOUND 

NONE 

UNUSED/*S* 

LOGICAL 

MAT 

OB 

/MATC/ 

CHAR»3 

100 

MATDESC 

36B 

/MATC/ 

CHAR*70 

100 

MATID 

271B 

CHAR*3 

MATTEN 

OB 

/MATN/ 

REAL 

700 

MERR 

4374B 

/MATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

700 

MRCOEF 

1 274B 

/MATN/ 

REAL 

700 

MTOT 

4375B 

/MATN/ 

INTEGER 

QA 

2570B 

/MATN/ 

REAL 

1 00 

QR 

2734B 

/MATN/ 

REAL 

100 

R 

267B 

INTEGER 

99 
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11 


-SYMBOLIC  CONSTANTS-- (LO=A) 


-NAME TYPE -VALUE 

MMAX  INTEGER  100 


-PROCEDURES--(LO=A) 

-NAME TYPE ARCS CLASS 

PF  3 SUBROUTINE 


-STATEMENT  LABELS-- ( LO=A) 


-LABEL- 

ADDRESS--- 

--PROPERTIES 

-DEF 

10 

INACTIVE 

DO-TERM 

35 

100 

164B 

FORMAT 

39 

200 

166B 

FORMAT 

40 

400 

170B 

FORMAT 

41 

-ENTRY 

POINTS--(LO=A) 

-NAME-- 

-ADDRESS-- 

ARCS--- 

QUIT 

5B 

0 

-I/O  UN1TS--(L0=A> 
-NAME PROPERTIES- 

TAPE6  AUX/FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

277B 

= 191 

CM  LABELLED  COMMON  LENGTH 

5730B 

= 3032 

CM  STORAGE  USED 

61000B 

= 25088 

COMPILE  TIME 

0.101 

SECONDS 

100 
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1 

SMATDB 

2 13 

2 

SMATDB 

2 14 

3 

SMATDB 

215 

4 

SMATDB 

2 18 

5 

SUBROUTINE  CHANGE 

SMATDB 

217 

6 

t*«(«**««*t«*«(***t««**t**********it*t*«*****«*««*t«**«****«**t*****«****COMH 

1 

7 

ttn 

COMMON  POR  DATABASE  OF  MATERIAL  PROPERTIES 

***COMM 

2 

8 

* COMM 

3 

9 

INTEGER  MMAX 

COMM 

4 

10 

PARAMETER  (MMAX=100) 

COMM 

5 

1 1 

COMMON  /MATN/  MATTENI MMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX),  QRIMMAI),  COMM 

8 

12 

$ MFREQIMMAX ,7) , MERR,  MTOT 

COMM 

7 

13 

COMMON  /MATC/MATIMMAX) .MATDESC (MMAX ) 

COMM 

8 

14 

INTEGER  MTOT,  MERR 

COMM 

9 

IS 

REAL  MATTEN,  MRCOEF,  MFREQ,  QA , QR 

COMM 

10 

U 

CHARACTER  * 3 MAT 

COMM 

11 

17 

CHARACTER  * 70  MATDESC 

COMM 

12 

18 

tttKt<ittttt*t*t**tttftftt**«ttt*t****tt**t«*t**ttAA*ft***tt**t«*tt*t**tttt  * COMM 

13 

19 

***«««t«««*tlk«*«**ftt*«**«ft«*«*«**A««***«««*ft«t«*«*«*1t*«ft*ik***«*ik*«1t*«*  « *COMM 

14 

20 

INTEGER  R,C, COMMAND,  VAL,  INDEX 

SMATDB 

2 19 

21 

CHARACTER  * 3 MATID 

SMATDB 

220 

22 

LOGICAL  FOUND 

SMATDB 

221 

23 

PRINT  *,  'ENTER  MATERIAL  I.D.  OF  GROUP  TO  BE  CHANGED' 

SMATDB 

222 

24 

READ  »,  MATID 

SMATDB 

223 

25 

FOUND  = .FALSE. 

SMATDB 

224 

28 

DO  20  R = 1 ,MMAX 

SMATDB 

225 

27 

IF  (MAT(R)  .EQ.  MATID)  THEN 

SMATDB 

228 

28 

PRINT  * 

SMATDB 

227 

29 

PRINT  *,  'LINE  1:  MATERIAL  ID  ' 

SMATDB 

228 

30 

PRINT  *,  NAT  (R) 

SMATDB 

229 

31 

PRINT  *,  'LINE  2;  DESCRIPTION' 

SMATDB 

230 

32 

PRINT  *,  MATDESC  (R) 

SMATDB 

231 

33 

PRINT  *,  'LINE  3:  FREQUENCIES' 

SMATDB 

232 

34 

PRINT  »,  (MFREQ  (R,C),  C=l,7> 

SMATDB 

233 

35 

PRINT  *,  'LINE  4:  ATTENUATIONS' 

SMATDB 

234 

38 

PRINT  »,  (MATTEN  (R,C),  C=l,7) 

SMATDB 

235 

37 

PRINT  *,  'LINE  5:  ATTENUATION  QUALITY  PERCENT' 

SMATDB 

238 

38 

PRINT  *,  QA  (R) 

SMATDB 

237 

39 

PRINT  *,  'LINE  8:  REFLECTION  COEFFICIENTS' 

SMATDB 

238 

40 

PRINT  *,  (MRCOEF  (R,C),  C=l,7> 

SMATDB 

239 

41 

PRINT  *,  'LINE  7:  REFLECTION  QUALITY  PERCENT' 

SMATDB 

240 

42 

PRINT  *,  QR  (R) 

SMATDB 

241 

43 

FOUND  = .TRUE. 

SMATDB 

242 

44 

INDEX  = R 

SMATDB 

243 

45 

END  IF 

SMATDB 

244 

48 

20 

CONTINUE 

SMATDB 

245 

47 

IF  (.NOT.  FOUND)  THEN 

SMATDB 

248 

48 

PRINT  *,  'MATERIAL  ',  MATID,  ' NOT  FOUND' 

SMATDB 

247 

49 

RETURN 

SMATDB 

248 

50 

END  IF 

SMATDB 

249 

51 

30 

PRINT  * 

SMATDB 

250 

52 

PRINT  *,  'ENTER  NUMBER  OF  LINE  TO  BE  CHANGED', 

SMATDB 

251 

53 

Z ' (99  TO  END  CHANGES)' 

SMATDB 

252 

54 

READ  *,  COMMAND 

SMATDB 

253 

55 

IF  (COMMAND  . EQ . 1)  THEN 

SMATDB 

254 

58 

PRINT  » , ' ENTER  NEW  I.D.' 

SMATDB 

255 

57 

MAT  (INDEX)  = ' 

SMATDB 

258 

58 

READ  »,  MATID 

SMATDB 

257 

59 

R = VAL  ( MATID(2 : 3)  ) 

SMATDB 

258 

80 

MAT  (R)  = MATID 

SMATDB 

259 

81 

MATDESC  (R)  = MATDESC  (INDEX) 

SMATDB 

280 

82 

MFREQ  (R,l)  = MFREQ  ( INDEX, 1) 

SMATDB 

281 

83 

MFREQ  (R,2)  = MFREQ  (INDEX, 2) 

SMATDB 

282 

84 

MFREQ  (R,3)  = MFREQ  (INDEX, 3) 

SMATDB 

283 

101 
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65 

MFREQ  (R,4) 

= MFREQ  (INDEX, 4) 

SMATDB 

264 

66 

MFREQ  (R,5) 

= MFREQ  (INDEX, 5) 

SMATDB 

265 

67 

MFREQ  <R,6) 

= MFREQ  (INDEX, 6) 

SMATDB 

266 

68 

MFREQ  <R,7) 

= MFREQ  (INDEX, 7) 

SMATDB 

267 

69 

MATTEN  (R,l) 

= MATTEN  (INDEX, 1) 

SMATDB 

268 

70 

MATTEN  (R,2) 

= MATTEN  (INDEX, 2) 

SMATDB 

269 

71 

MATTEN  (R,3) 

= MATTEN  (INDEX, 3) 

SMATDB 

270 

72 

MATTEN  (R,4) 

= MATTEN  (INDEX, 4) 

SMATDB 

271 

73 

MATTEN  (R,5) 

= MATTEN  (INDEX, 5) 

SMATDB 

272 

74 

MATTEN  (R,6) 

= MATTEN  (INDEX, 6) 

SMATDB 

273 

75 

MATTEN  (R,7) 

= MATTEN  (INDEX, 7) 

SMATDB 

274 

76 

QA  (R)  = QA 

( INDEX) 

SMATDB 

275 

77 

MRCOEF  (R,l) 

= MRCOEF  (INDEX, 1) 

SMATDB 

276 

78 

MRCOEF  (R,2) 

= MRCOEF  (INDEX, 2) 

SMATDB 

277 

79 

MRCOEF  (R,3) 

3 MRCOEF  (INDEX, 3) 

SMATDB 

278 

80 

MRCOEF  <R,4) 

= MRCOEF  (INDEX, 4) 

SMATDB 

279 

81 

MRCOEF  (R,5) 

= MRCOEF  (INDEX, 5) 

SMATDB 

280 

82 

MRCOEF  (R,6) 

= MRCOEF  (INDEX, 6) 

SMATDB 

281 

83 

MRCOEF  (R,7) 

= MRCOEF  (INDEX, 7) 

SMATDB 

282 

84 

QR  <R)  = QR 

( INDEX) 

SMATDB 

283 

85 

INDEX  = R 

SMATDB 

284 

86 

ELSE  IF  ( COMMAND  .EQ.  2 ) THEN 

SMATDB 

285 

87 

PRINT  *,  ‘ENTER  NEW  ONE  LINE  DESCRIPTION  OF  MATERIAL' 

SMATDB 

286 

88 

READ  *,  MATDESC  (INDEX) 

SMATDB 

287 

89 

ELSE  IF  ( COMMAND  .EQ.  3 ) THEN 

SMATDB 

288 

90 

PRINT  *,  ‘ENTER  NEW  SET  OF  7 FREQUENCIES' 

SMATDB 

289 

91 

READ  *,  (MFREQ  (INDEX, C),  Csl,7) 

SMATDB 

290 

92 

ELSE  IF  ( COMMAND  .EQ.  4 ) THEN 

SMATDB 

291 

93 

PRINT  »,  ‘ENTER  NEW  SET  OF  7 ATTENUATIONS' 

SMATDB 

292 

94 

READ  *,  (MATTEN  ( INDEX, C),  C»l,7) 

SMATDB 

293 

95 

ELSE  IF  ( COMMAND  .EQ.  5 > THEN 

SMATDB 

294 

96 

PRINT  *,  ‘ENTER  NEW  ATTENUATION  QUALITY  PERCENT' 

SMATDB 

295 

97 

READ  *,  QA  (INDEX) 

SMATDB 

296 

98 

ELSE  IF  ( COMMAND  .EQ.  6 ) THEN 

SMATDB 

297 

99 

PRINT  *,  ‘ENTER  NEW  SET  OF  7 REFLECTION  COEFFICIENTS’ 

SMATDB 

298 

100 

READ 

*,  (MRCOEF  (INDEX, 

C),  C=1 ,7) 

SMATDB 

299 

101 

ELSE  IF 

( COMMAND  EQ.  7 ) 

THEN 

SMATDB 

300 

102 

PRINT 

*,  ‘ENTER  NEW  REFLECTION  QUALITY  PERCENT' 

SMATDB 

301 

103 

READ 

*,  QR  (INDEX) 

SMATDB 

302 

104 

ELSE  IF 

( COMMAND  EQ.  99 

) THEN 

SMATDB 

303 

105 

GOTO 

40 

SMATDB 

304 

106 

END  IF 

SMATDB 

305 

107 

GOTO  30 

SMATDB 

306 

108 

C 

SMATDB 

307 

109 

40 

PRINT  * 

SMATDB 

308 

no 

PRINT  *, 

MAT  (INDEX) 

SMATDB 

309 

111 

PRINT  *, 

MATDESC  (INDEX) 

SMATDB 

310 

112 

PRINT  », 

(MFREQ  (INDEX, C), 

C»1  ,7) 

SMATDB 

311 

113 

PRINT  *, 

(MATTEN  ( INDEX, C) 

, C=l,7) 

SMATDB 

312 

114 

PRINT  *, 

QA  (INDEX) 

SMATDB 

313 

115 

PRINT  », 

(MRCOEF  (INDEX, C) 

, C»l,7) 

SMATDB 

314 

116 

PRINT  *, 

QR  (INDEX) 

SMATDB 

315 

117 

PRINT  • 

SMATDB 

316 

118 

RETURN 

SMATDB 

317 

119 

END 

SMATDB 

318 

102 


14 
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--VARIABLE  MAP--(LO=A) 


NAME--- 

ADDRESS- 

-BLOCK--- 

--PROPERTIES 

TYPE 

--SIZE 

C 

1 137B 

INTEGER 

COMMAND 

1 HOB 

INTEGER 

FOUND 

1 143B 

LOGICAL 

INDEX 

1141B 

INTEGER 

MAT 

OB 

/MATC/ 

CHAR* 3 

100 

MATDESC 

34B 

/MATC/ 

CHAR*70 

100 

MAT  ID 

1142B 

CHAR* 3 

MATTEN 

OB 

/MATN/ 

REAL 

700 

MERR 

437  4B 

/MATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

700 

MRCOEF 

1 27  4B 

/MATN/ 

REAL 

700 

MTOT 

4375B 

/MATN/ 

INTEGER 

QA 

2570B 

/MATN/ 

REAL 

100 

OR 

2734B 

/MATN/ 

REAL 

100 

R 

1 134B 

INTEGER 

--SYMBOLIC  CONSTANTS--(LO=A) 


-NAME TYPE--- VALUE 

MMAX  INTEGER  100 


--PROCEDURES--(LO=A) 


-NAME-- 

TYPE 

ARCS 

-CLASS 

VAL 

INTEGER 

1 

FUNCTION 

-STATEMENT  LABELS- 

-(LO=A) 

-LABEL- 

ADDRESS 

-PROPERTIES--- 

-DEF 

20 

INACTIVE 

DO-TERM 

44 

30 

20  4B 

51 

40 

477B 

109 

--ENTRY  POINTS--(LO=A) 
-NAME---ADDRESS--ARGS--- 

CHANGE  SB  0 


--STATISTICS-- 


PROGRAM-UNIT  LENGTH 

1140B 

= 424 

CM  LABELLED  COMMON  LENGTH 

S730B 

= 3032 

CM  STORAGE  USED 

43000B 

s 24112 

COMPILE  TIME 

0 .318 

SECONDS 

103 
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1 

SUBROUTINE  LMATTER 

LMATTER 

1 

2 

t 1 1 

1 ! 1 M ! 1 1 1 1 1 1 M 1 1 1 1 1 1 1 1 1 1 1 M M 1 M M 1 1 1 1 1 1 1 1 1 M M 1 1 1 1 M 1 1 1 1 1 1 

1 1 1 1 I 1 1 1 M LMATTER 

2 

3 

* 1 I 

! 

! ! '.LMATTER 

3 

4 

t ! 1 

! THIS  SUBROUTINE  LOADS  THE  MATERIAL  DATABASE  INTO  ARRAYS 

FOR  ! ! ! LMATTER 

4 

5 

* ! ! 

! FURTHER  PROGRAM  USE. 

! ! '.  LMATTER 

5 

4 

t ! ! 

1 

! ! ! LMATTER 

6 

7 

* 1 1 

1 M 1 M M 1 1 1 1 1 t 1 II  1 1 1 1 II  t 1 1 1 1 M M M 1 M 1 1 1 II  1 1 M 1 1 i 1 1 M 1 1 1 1 II 

1 1 1 1 1 1 1 1 M LMATTER 

7 

8 

**  Hr  **  «r  **************  ***************************  k****  A **  It  * ***************  LMATTER 

8 

9 

***********************************«********************************«***(;;qK)i{ 

1 

10 

*** 

COMMON  FOR  DATABASE  OF  MATERIAL  PROPERTIES 

***COMM 

2 

11 

***********************************************************************  * COMM 

3 

12 

INTEGER  MMAX 

COMM 

4 

13 

PARAMETER  (MMAX=100) 

COMM 

5 

14 

COMMON  /NATN/  MATTENIMMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX), 

QR(NMAX),  COMM 

6 

15 

$ MFREQ(MMAX,7) , MERR,  MTOT 

COMM 

7 

U 

COMMON  /MATC/ MAT (MMAX) .MATDESC (MMAX ) 

COMM 

8 

17 

INTEGER  MTOT,  MERR 

COMM 

9 

18 

REAL  MATTEN,  MRCOEF,  MFREQ,  QA , OR 

COMM 

10 

19 

CHARACTER  * 3 MAT 

COMM 

11 

20 

CHARACTER  * 70  MATDESC 

COMM 

12 

21 

A*********************************************************************  * * COMM 

13 

22 

************************************************************************C  OMM 

14 

23 

************************************************** 

LMATTER 

10 

24 

* 

DECLARATION  OF  VARIABLES 

LMATTER 

11 

25 

«*«ft*****««ftft*«*ft****At**lk***A«**«*«ftft******««*«t« 

LMATTER 

12 

26 

INTEGER  R,  C,  VAL 

LMATTER 

13 

27 

CHARACTER  * 3 MATID 

LMATTER 

14 

28 

LMATTER 

15 

29 

A 

GET  FILE 

LMATTER 

16 

30 

************************************************** 

LMATTER 

17 

31 

MERR  = 0 

LMATTER 

18 

32 

CALL  PF  ( 'GET' ,0, 'MATTER' , 'RC , MERR) 

LMATTER 

19 

33 

AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 

LMATTER 

20 

34 

A 

FILE  ERROR  CHECK 

LMATTER 

21 

35 

A*AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 

LMATTER 

22 

36 

IF  ( MERR  .EQ.  0 ) THEN 

LMATTER 

23 

37 

999 

CONTINUE 

LMATTER 

24 

38 

ELSE  IF  ( MERR  .EQ.  2 > THEN 

LMATTER 

25 

39 

CALL  WARNING  (3) 

LMATTER 

26 

40 

RETURN 

LMATTER 

27 

41 

ELSE 

LMATTER 

28 

42 

CALL  WARNING  (4) 

LMATTER 

29 

43 

RETURN 

LMATTER 

30 

44 

END  IF 

LMATTER 

31 

45 

A*AA*AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 

LMATTER 

32 

46 

A 

OPEN  FILE 

LMATTER 

33 

47 

AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 

LMATTER 

34 

48 

OPEN  (UNIT  = 3,  F ILE=' MATTER ' ,FORM=' FORMATTED  ' , 

LMATTER 

35 

49 

5 STATUS  = 'OLD',  ACCESS  = 'SEQUENTIAL') 

LMATTER 

36 

SO 

REWIND  (3) 

LMATTER 

37 

51 

AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 

LMATTER 

38 

52 

A 

INITIALIZE  ARRAYS 

LMATTER 

39 

S3 

AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 

LMATTER 

40 

54 

DATA  NAT  / 100  * ' ' / 

LMATTER 

41 

55 

DATA  MATDESC  / 100  * ' ' / 

LMATTER 

42 

56 

DATA  MFREQ  / 700  » 0.0  / 

LMATTER 

43 

57 

DATA  MATTEN  / 700  * 0.0  / 

LMATTER 

44 

58 

DATA  QA  / 100  * 0.0  / 

LMATTER 

45 

59 

DATA  MRCOEF  / 700  » 0 . 0 / 

LMATTER 

46 

60 

DATA  OR  / 100  * 0.0  / 

LMATTER 

47 

61 

************************************************** 

LMATTER 

48 

62 

A 

READ  IN  THE  MATERIAL  FILE 

LMATTER 

49 

63 

************************************************** 

LMATTER 

50 

64 

10 

READ  (3, 1000,END=20)  MATID 

LMATTER 

51 

104 
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65 

R = VAL(MATID( 2 : 3) ) 

LMATTER 

52 

66 

MAT  (R)  = MAT  ID 

LMATTER 

53 

67 

READ  (3,2000,END=20) 

MATDESC  (R) 

LMATTER 

54 

68 

READ  (3,4000,END=20) 

(MFREQ(R,C) ,C=1 ,7) 

LMATTER 

55 

69 

READ  ( 3 , 4000 , END=20 ) 

(MATTEN(R,C) ,C=1, 7) 

LMATTER 

56 

70 

READ  (3 , 4000 ,END=20) 

QA  (R) 

LMATTER 

57 

71 

READ  (3,4000,END=20) 

(MRCOEF(R,C) ,C=1,7) 

LMATTER 

58 

72 

READ  (3,400Q,END=20) 

OR  (R) 

LMATTER 

59 

73 

GOTO  10 

LMATTER 

60 

74 

20 

CONTINUE 

LMATTER 

61 

75 

1000 

FORMAT  (A3) 

LMATTER 

62 

76 

2000 

FORMAT  (A70) 

LMATTER 

63 

77 

40  00 

FORMAT  (7(1X,E9.3)) 

LMATTER 

64 

78 

ttttttttttttttttttttttt 

LMATTER 

65 

79 

• CLOSE  FILE 

LMATTER 

66 

80 

LMATTER 

67 

81 

CLOSE  (3, STATUS  = 'DELETE') 

LMATTER 

68 

82 

RETURN 

LMATTER 

69 

83 

END 

LMATTER 

70 

:able  map 

--(LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


C 

32  76 

INTEGER 

MAT 

OB 

/MATC/ 

CHAR*3 

100 

MATDESC 

36B 

/MATC/ 

CHAR»70 

1 00 

MAT  ID 

330B 

CHAR*3 

MATTEN 

OB 

/MATN/ 

REAL 

700 

MERR 

4 3 7 4B 

/MATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

700 

MRCOEF 

1 27  4B 

/MATN/ 

REAL 

700 

MTOT 

4375B 

/MATN/ 

INTEGER 

QA 

2570B 

/MATN/ 

REAL 

100 

QR 

2734B 

/MATN/ 

REAL 

1 00 

R 

326B 

INTEGER 

-SYMBOLIC  CONSTANTS-- (LO=A) 

-NAME TYPE VALUE 

MMAX  INTEGER  lOQ 


-PROCEDURES--(LO=A) 

-NAME TYPE ---ARCS CLASS 

PF  5 SUBROUTINE 

VAL  INTEGER  1 FUNCTION 

WARNING  1 SUBROUTINE 


-STATEMENT  LABELS-- ( LO=A) 

-LABEL- ADDRESS PROPERTIES DEF  -LABEL-ADDRESS PROPERTIES DEF 


1 0 3 6B 

64 

1000 

20  2B 

FORMAT 

75 

20  160B 

74 

2000 

204B 

FORMAT 

76 

999  »NO  REFS* 

37 

40  00 

206B 

FORMAT 

77 

105 
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-ENTRY  POINTS--(LO=A) 

-NAME ADDRESS-- ARCS 

LMATTER  5B  0 


-I/O  UNITS--(LO=A) 
-NAME PROPERTIES- 

TAPE3  AUX/FMT/SEQ 


-STATISTICS-- 

336B  = 222 

S730B  = 3032 

61000B  - 25088 

0.127  SECONDS 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


106 
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1 

SUBROUTINE  WARNING(ERR) 

WARNING 

1 

2 

INTEGER  ERR,  ERRM 

WARNING 

2 

3 

CHARACTERM5  MESSAGE(20) 

WARNING 

3 

4 

DATA 

MESSAGE!  l)/'"HOLE"  DATA  FILE  DOES  NOT  EXIST 

FOR  THIS 

BLDG  • / 

WARNING 

4 

5 

DATA 

MESSAGE!  2) /'FILE  HANDLING  PROBLEM  ON  "HOLE- 

DATA  FILE 

' / 

WARNING 

5 

6 

DATA 

MESSAGE!  3) /'"MATTER"  FILE  DOES  NOT  EXIST  FOR 

THIS  BLDG  '/ 

WARNING 

6 

7 

DATA 

MESSAGE!  4) /'FILE  HANDLING  PROBLEM  ON  "MATTER 

FILE 

' / 

WARNING 

7 

8 

DATA 

MESSAGE!  5)/ '"TYPE"  DATA  FILE  DOES  NOT  EXIST 

FOR  THIS 

BLDG ' / 

WARNING 

8 

9 

DATA 

MESSAGE!  6)/ 'FILE  HANDLING  PROBLEM  ON  "TYPE" 

FILE 

' / 

WARNING 

9 

10 

DATA 

MESSAGE!  7)/ '"WALL"  DATA  FILE  DOES  NOT  EXIST 

FOR  THIS 

BLDG  ' / 

WARNING 

10 

11 

DATA 

MESSAGE!  8) /'FILE  HANDLING  PROBLEM  ON  "WALL" 

FILE 

' / 

WARNING 

1 1 

12 

DATA 

MESSAGE!  9)/ 'HEIGHT  AND  WIDTH  OF  ROOM  MISSING 

' / 

WARNING 

12 

13 

DATA 

MESSAGE! 10) /' LENGTH  OF  ROOM 

IS  HISSING 

■ / 

WARNING 

13 

1 4 

DATA 

MESSAGE! 11 )/' FREQ  FILE  DOES  : 

NOT  EXIST  FOR  THIS  BLDG 

' / 

WARNING 

14 

IS 

DATA 

MESSAGE! 12) /' FILE  HANDLING  PROBLEM  WITH  FREQ 

FILE 

' / 

WARNING 

15 

1 6 

DATA 

MESSAGE! 13) / 'WARNING  CODE  IS 

OUT  OF  RANGE 

• / 

WARNING 

16 

17 

DATA 

MES5AGE!14)/ 'WARNING  CODE  IS 

OUT  OF  RANGE 

' / 

WARNING 

17 

18 

DATA 

MESSAGE! IS )/ 'WARNING  CODE  IS 

OUT  OF  RANGE 

' / 

WARNING 

18 

19 

DATA 

MESSAGE!16)/ 'WARNING  CODE  IS 

OUT  OF  RANGE 

' / 

WARNING 

19 

20 

DATA 

MESSAGE! 17 )/ 'WARNING  CODE  IS 

OUT  OF  RANGE 

' / 

WARNING 

20 

21 

DATA 

MESSAGE!18)/ 'WARNING  CODE  IS 

OUT  OF  RANGE 

' / 

WARNING 

21 

22 

DATA 

MESSAGE! 19 )/ 'WARNING  CODE  IS 

OUT  OF  RANGE 

' / 

WARNING 

22 

23 

DATA 

MESSAGE!20)/ 'WARNING  CODE  IS 

OUT  OF  RANGE 

' / 

WARNING 

23 

24 

ERRM= 

12 

WARNING 

24 

2S 

I ERR 

= ERR 

WARNING 

25 

26 

IF(ERR.GT.ERRM)  IERR=20 

WARNING 

26 

27 

WRITE! 6 , 20) 

WARNING 

27 

28 

WRITE(6,10)  ERR, MESSAGE! lERR) 

WARNING 

28 

29 

VRITE!6 , 20 ) 

WARNING 

29 

30 

10 

FORMAT!'  ***WARNING  NUMBER  = ',15 

,'  **♦  ',A45) 

WARNING 

30 

31 

20 

FORMAT!'  ') 

WARNING 

31 

32 

RETURN 

WARNING 

32 

33 

END 

WARNING 

33 

-VARIABLE  MAP--(LO=A) 
-NAME ADDRESS- -BLOCK- 


-PROPERTIES TYPE SIZE 


ERR 

ERRM 

lERR 

MESSAGE 


1 DUMMY-ARG 
60B 
213B 
61B 


INTEGER 

INTEGER 

INTEGER 

CHAR*45 


20 


-STATEMENT  LABELS-- ( LO=A ) 

•LABEL- ADDRESS PROPERTIES DEF 


10 

20 


34B 

42B 


FORMAT 

FORMAT 


-ENTRY  POINTS--(LO=A) 
-NAME---ADDRESS--ARGS--- 


VARNING 


SB 


30 

31 


FTN  5 . U552  83  / 

12/24 

. 09  , 

48  . 

06 

PACE 

SUBROUTINE  WARNING  74 

/175 

OPT. 

>0 

— I/O  UNITS--!LO  = A) 

-NAME PROPERTIES--- 

TAPE6  FMT/SEQ 

--STATISTICS-- 

PROGRAM-UNIT  LENGTH 

216 

B > 

142 

CM  STORAGE  USED 

61 

000 

B . 

2501 

COMPILE  TIME 

0 

063 

SECONDS 

19 
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20 


1 

SUBROUTINE  ERROR! lERR) 

ERROR 

1 

2 

CHARACTER* 45 

MESSAGE!20) 

ERROR 

2 

3 

DATA 

MESSAGE! 

1 ) / 'MATERIALS 

DATA 

L BASE 

IS  EMPTY 

' / 

ERROR 

3 

4 

DATA 

MESSAGE! 

2)1 ' FREQUENCY 

IS  OUT  OF  : 

RANGE 

' / 

ERROR 

4 

5 

DATA 

MESSAGE! 

3) / 'THIS  MATERIAL 

IS  NOT 

IN  DATA  BASE 

' / 

ERROR 

5 

6 

DATA 

MESSAGE! 

4) / 'DENOMINATOR  IS 

1 ZERO 

' / 

ERROR 

6 

7 

DATA 

MESSAGE! 

5)  / ' FILE  HANDLING 

ERROR 

' / 

ERROR 

7 

8 

DATA 

MESSAGE! 

6) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

8 

9 

DATA 

MESSAGE! 

7) /'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

9 

10 

DATA 

MESSAGE! 

8) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

* / 

ERROR 

10 

11 

DATA 

MESSAGE! 

9) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

11 

12 

DATA 

MESSAGE! 

10) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

12 

13 

DATA 

MESSAGE! 11 ) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

13 

14 

DATA 

MESSAGE! 12) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

14 

15 

DATA 

MESSAGE! 13)/ 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

15 

16 

DATA 

MESSAGE! 14) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

16 

17 

DATA 

MESSAGE! IS) /'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

17 

18 

DATA 

MESSAGE! 16) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

18 

19 

DATA 

MESSAGE! 17 ) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

19 

20 

DATA 

MESSAGE! 18) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

20 

21 

DATA 

MESSAGE! 19 ) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

21 

22 

DATA 

MESSAGE!20) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

22 

23 

IERRM=5 

ERROR 

23 

24 

IFCIERR.GT. lERRM)  IERR=20 

ERROR 

24 

25 

WRITE(6,10)  lERR, MESSAGE! lERR) 

ERROR 

25 

26  10 

FORMAT!*  »**ERROR  NUMBER 

,15, 

* tut 

' ,A45) 

ERROR 

26 

27 

CALL 

PMDSTOP 

ERROR 

27 

28 

STOP 

' ERROR' 

ERROR 

28 

29 

END 

ERROR 

29 

-VARIABLE  MAP--(LOrA) 

-NAME---ADDRESS--BLOCK PROPERTIES- TYPE SIZE 


I ERR 

1 DUMMY -ARG 

INTEGER 

lERRM 

210B 

INTEGER 

MESSAGE 

56B 

CHAR* 45 

20 

-PROCEDURES--(LO=A) 

-NAME TYPE ARCS CLASS 

PMDSTOP  0 SUBROUTINE 


-STATEMENT  LABELS-- ( LO=A ) 
-LABEL-ADDRESS PROPERTIES DEF 

10  36B  FORMAT  26 
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-ENTRY  POINTS--(LO=A) 
-NAME---ADDRESS--ARGS-- 

ERROR  SB  1 


— I/O  UNITS--(LO  = A) 
-NAME PROPERTIES 

TAPE6  FMT/SEQ 


--STATISTICS-- 

PROGRAM-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


213B  = 139 

61000B  = 25088 

0.056  SECONDS 
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1 
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1 

PROGRAM  SHOLES  ( INPUT, TAPEUINPUT) 

SHOLES 

1 

2 

* 

SHOLES 

2 

3 

*THIS  INTERACTIVE  PROGRAM  INPUTS  THE  DATA 

DESCRIBING  EACH 

HOLE 

SHOLES 

3 

4 

*IN  THE  BUILDING  AND  STORES  IT.  THE  FILE 

NAME  IS  CREATED 

BY 

SHOLES 

4 

5 

"ATTACHING  "B"  TO  THE  FRONT  OF  AND  "H"  TO 

THE  BACK  OF  THE 

BUILDING 

SHOLES 

5 

8 

‘IDENTIFICATION.  THE  BUILDING  IDENTIFICATION  CAN  BE  NO  MORE 

SHOLES 

8 

7 

‘THAN  5 ALPHANUMERIC  CHARACTERS. 

SHOLES 

7 

8 

SHOLES 

8 

9 

10 
11 
1 2 

13 

14 

15 
U 

17 

18 

19 

20 
21 
22 

23 

24 

25 
28 

27 

28 

29 

30 

31 

32 

33 

34 

35 
38 

37 

38 

39 

40 

41 

42 

43 

44 

45 
48 

47 

48 

49 

50 

51 

52 

53 

54 

55 
58 

57 

58 

59 
80 
81 
82 

83 

84 


***  COMMON  FOR  INITIAL  PARAMETERS 

***fkiitiktt*lt*tt«i****  + *itltik*lk****  + «li*  + ik***k  + lt***«i)ii*t)«****tt*lt****««**it 

INTEGER  FMAX 
PARAMETER  (FMAX  = 50) 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX 
5 FTOT 

COMMON  /INITILC/  BLDG 
CHARACTER  * 5 BLDG 
REAL  FREQ,  AFLAG,  RFLAG,  FREQA 
INTEGER  QUALITY,  FERR,  FTOT 

*t*****1i*****1itii****tt1i**t*tt1itt****iitt1tii*t***t**tt**1i*******1i 
ltlt*i*A****tt4i1tA<i*4l**i*****  + 1tlt1i*iiilt  + fi*it***ilr*lt  + **  + lt******lttt<i**<i)t**ik* 

***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  VALLS 

tt**t*»**ltt*fk****1t**lit****t1i*1i***1tt**1tt****t*t1t1i1(tt*t*1(**fktit 


******** » *COMF 
*»»COMF 
****** ****COMF 

COMF 

COMF 

),  FERR,  COMF 
COMF 
COMF 
COMF 
COMF 
COMF 

*********  *C0MF 
********  * *COMF 
********«*COMR 
***COMR 
**********COMR 


INTEGER  RMAX  COMR 
PARAMETER  (RMAX  = 20)  COMR 
COMMON  /ROOMN/  ROOM(RMAX  + 8,  RMAX  ♦ 8),  NROOMS , RAREA(RMAX)  COMR 
INTEGER  NROOMS  COMR 
REAL  ROOM  COMR 


***********************************************************************  * COMR 


***********************************************************************  *^Ql^J^ 

***********************************************************************  * COMH 


***  COMMON  FOR  DATABASE  OF  LOCATIONS  OF  DOORS  AND  WINDOWS  ***COMH 

************************************************************************  COMH 
INTEGER  HMAX  COMH 

PARAMETER  (HMAX  = 35)  COMH 

COMMON  /HOLEN/  HTOT , HERR  COMH 

COMMON  /HOLEC/  HOLE(HMAX,4)  COMH 

INTEGER  HTOT,  HERR  COMH 

CHARACTER  * 3 HOLE  COMH 

* DESCRIPTION  OF  ARRAYS  COMH 

* ROOM  IDENTIFICATION  APERTURE  ID  COMH 

* COMH 

* DIRECTION  FROM  ROOM  TO  ROOM  COMH 

* COMH 

* HOLE(X,l)  HOLE(X,2)  HOLE(X,3)  HOLE(X,4)  COMH 

* A3  A3  A3  A3  COMH 


***********************************************************************  *COMH 


**********************************************************************  * * COMH 


INTEGER  GETLEN, QUIT, ABORT, ANSWER, OLDFILE ,N,Y1 ,Y2 , LINE  SHOLES 

INTEGER  lERR  SHOLES 

CHARACTER  * 7 PFN  SHOLES 

* SHOLES 

* INITIALIZATION  SHOLES 

QUIT  = 0 SHOLES 

HTOT  = 0 SHOLES 

ABORT  = 0 SHOLES 

100  PRINT*  SHOLES 

PRINT  *,  'ENTER  BUILDING  IDENTIFICATION  (E.G.  ''101'')'  SHOLES 

PRINT  ‘ (NO  MORE  THAN  5 ALPHANUMERIC  CHARACTERS)'  SHOLES 

REWIND  1 SHOLES 

READ(1,*,END=100)  BLDG  SHOLES 


1 

2 

3 

4 

5 
8 

7 

8 
9 

10 

11 

12 

13 

1 

2 

3 

4 

5 
8 

7 

8 
9 

10 

1 

2 

3 

4 

5 
8 
7 


9 

10 

11 

12 

13 

14 

15 
18 

17 

18 

19 

20 
12 

13 

14 

15 
18 

17 

18 

19 

20 
21 
22 

23 

24 
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65 

SHOLES 

25 

66 

IF  ( GETLEN(BLDC)  . GT  5 ) THEN 

SHOLES 

2 6 

67 

GO  TO  100 

SHOLES 

27 

68 

END  IF 

SHOLES 

28 

69 

PFN  = ’B'  II  BLDG( 1 ;GETLEN(BLDG) ) II  'H' 

SHOLES 

29 

70 

t 

SHOLES 

30 

71 

LOAD  DATA  FROM  EXISTING  FILE  IF  NECESSARY 

SHOLES 

31 

72 

200 

PRINT* 

SHOLES 

32 

73 

PRINT* , 'WILL  THIS  BE ' 

SHOLES 

33 

74 

PRINT*,'  (1)  A MODIFICATION  OF  AN  EXISTING  FILE?' 

SHOLES 

34 

75 

PRINT* , ' ( 2 ) A NEW  FILE? ' 

SHOLES 

35 

76 

PRINT* ENTER  A NUMBER  !!!' 

SHOLES 

36 

77 

REWIND  1 

SHOLES 

37 

78 

READCl ,*,END=200)  OLDFILE 

SHOLES 

38 

79 

IF  ( ( OLDFILE  .NE.  1 ) AND.  ( OLDFILE  .NE.  2 ) ) THEN 

SHOLES 

39 

80 

GOTO  200 

SHOLES 

40 

81 

ELSE  IF  ( OLDFILE  .EQ.  1 ) THEN 

SHOLES 

41 

82 

« 

SHOLES 

4 2 

83 

CHECK  FOR  EXISTENCE  OF  PERMANENT  FILE  OF  SAME  NAME 

SHOLES 

43 

84 

I ERR  = 0 

SHOLES 

44 

85 

CALL  PF  ( 'GET'  ,0,PFN(1 :GETLEN(PFN) > , 'RC' , lERR) 

SHOLES 

45 

86 

IF  ( lERR  EQ.  2 ) THEN 

SHOLES 

46 

87 

PRINT* 

SHOLES 

47 

88 

PRINT  *,  'FILE  ' ,PFN,  ' NOT  FOUND' 

SHOLES 

48 

89 

PRINT*,  'PROGRAM  ABORTED!! ! ■ 

SHOLES 

49 

90 

PRINT* 

SHOLES 

50 

91 

PRINT*,  'FIND  CORRECT  BUILDING  IDENTIFIER  AND  RESTART  ', 

SHOLES 

51 

92 

+ 'PROGRAM' 

SHOLES 

52 

93 

PRINT* 

SHOLES 

53 

94 

STOP 

SHOLES 

54 

95 

It 

SHOLES 

55 

96 

ELSE 

SHOLES 

56 

97 

CALL  LHOLE 

SHOLES 

57 

98 

IF  (HERR  NE.  0)  CALL  ERROR(5) 

SHOLES 

58 

99 

END  IF 

SHOLES 

59 

100 

ELSE  IF  ( OLDFILE  EQ.  2 ) THEN 

SHOLES 

60 

10  1 

* 

SHOLES 

6 1 

1 02 

lit  * ft 

CHECK  FOR  EXISTENCE  OF  PERMANENT  FILE  OF  SAME  NAME 

SHOLES 

62 

103 

lERR  = 0 

SHOLES 

63 

104 

CALL  PF  ( 'GET' ,0 , PFN(1 ;GETLEN(PFN1 ) , 'RC ' , lERR) 

SHOLES 

64 

105 

IF  ( lERR  .EQ.  0 ) THEN 

SHOLES 

65 

106 

PRINT* 

SHOLES 

66 

107 

PRINT*,  'DATA  FILE  ALREADY  EXISTS  FOR  BUILDING  ',BLDG 

SHOLES 

67 

108 

PRINT* 

SHOLES 

68 

109 

PRINT*, 'IF  YOU  ENTER  DATA  AND  STORE  IT,  YOU  WILL  WRITE  ', 

SHOLES 

69 

1 10 

+ 'OVER  THE  OLD  FILE.  ' 

SHOLES 

70 

111 

250 

PRINT* 

SHOLES 

71 

1 12 

PRINT*, 'YOU  MAY  EITHER  (1)  ABORT  OR  (2)  CONTINUE.' 

SHOLES 

72 

113 

PRINT* ,' INDICATE  YOUR  CHOICE  BY  ENTERING  A NUMBER.' 

SHOLES 

73 

1 14 

REWIND  1 

SHOLES 

74 

115 

READ( 1 , *,END=250)  ANSWER 

SHOLES 

75 

1 16 

IF  ( ANSWER  .EQ.  1 ) THEN 

SHOLES 

76 

117 

PRINT* 

SHOLES 

77 

1 18 

PRINT* ,' PROGRAM  HAS  BEEN  ABORTED,  AT  YOUR  REQUEST' 

SHOLES 

78 

119 

PRINT* 

SHOLES 

79 

120 

STOP 

SHOLES 

80 

12  1 

ELSE  IF  ( ANSWER  . EQ . 2 > THEN 

SHOLES 

8 1 

122 

CONTINUE 

SHOLES 

82 

TRIVIAL* 

CONTINUE  WITH  NO  STATEMENT  LABEL  --  IGNORED 

1 23 

ELSE 

SHOLES 

83 

124 

GOTO  250 

SHOLES 

84 

125 

END  IF 

SHOLES 

85 

126 

ELSE  IF  ( lERR  . EQ . 2 > THEN 

SHOLES 

86 

127 

* 

SHOLES 

87 

111 
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128 

UK  t 

NO  DATA  FILE  ALREADY  EXISTS  FOR  THIS  BUILDING  AND  DATA  ENTRY 

SHOLES 

88 

129 

A « * 

CAN  CONTINUE 

SHOLES 

89 

130 

CONTINUE 

SHOLES 

90 

TRIVIAL* 

131 

CONTINUE  WITH  NO  STATEMENT  LABEL  --  IGNORED 
ELSE 

SHOLES 

91 

132 

* 

SHOLES 

92 

133 

t ** 

PERMANENT  FILE  ERROR 

SHOLES 

93 

1 34 

PRINT* 

SHOLES 

94 

135 

PRINT* , ’PROGRAM  ABORTED  !!!' 

SHOLES 

95 

1 38 

PRINT*,'  SOME  PERMANENT  FILE  ERROR  HAS  OCCURRED.' 

SHOLES 

98 

137 

PRINT*,'  DOUBLE  CHECK  YOUR  BUILDING  IDENTIFICATION 

SHOLES 

97 

1 38 

+ 'AND  TRY  AGAIN' 

SHOLES 

98 

139 

STOP 

SHOLES 

99 

140 

END  IF 

SHOLES 

1 00 

14  1 

A 

SHOLES 

101 

142 

PRINT* 

SHOLES 

102 

143 

PRINT*,  ' BEGIN  ENTERING  DATA ' 

SHOLES 

103 

1 44 

300 

HTOT  = HTOT  + 1 

SHOLES 

104 

145 

IF  ( HTOT  .EQ.  1)  THEN 

SHOLES 

105 

148 

CALL  DATAIN( 1 ,HTOT) 

SHOLES 

108 

147 

ELSE 

SHOLES 

107 

148 

CALL  DATA  IN  <0,HTOT) 

SHOLES 

1 08 

149 

END  IF 

SHOLES 

109 

150 

400 

PRINT* 

SHOLES 

110 

151 

PRINT*,  'DO  YOU  WANT  TO  ENTER  MORE  DATA?', 

SHOLES 

1 1 1 

152 

+ ' <1)  YES  (2)  NO' 

SHOLES 

1 12 

153 

PRINT*,  ' ENTER  A NUMBER  !!!' 

SHOLES 

113 

154 

REWIND  1 

SHOLES 

114 

155 

READd  , *,  END  = 400  ) ANSWER 

SHOLES 

115 

158 

IF  ( (ANSWER  .NE.  1)  .AND.  (ANSWER  NE.  2)  ) THEN 

SHOLES 

118 

157 

GOTO  400 

SHOLES 

117 

158 

ELSE  IF  ( ANSWER  .EQ.  1)  THEN 

SHOLES 

118 

159 

GOTO  300 

SHOLES 

119 

180 

ELSE  IF  ( ANSWER  EQ.  2 ) THEN 

SHOLES 

120 

18  1 

PRINT* 

SHOLES 

121 

182 

PRINT*,  'DATA  ENTRY  DISCONTINUED' 

SHOLES 

122 

183 

END  IF 

SHOLES 

123 

184 

END  IF 

SHOLES 

124 

185 

A 

SHOLES 

125 

188 

A * « 

MANIPULATE  DATA 

SHOLES 

128 

187 

CALL  MANIP  (QUIT, ABORT) 

SHOLES 

127 

188 

A 

SHOLES 

128 

189 

AAA 

TERMINATE  PROGRAM,  STORING  DATA  IF  NECESSARY 

SHOLES 

129 

170 

IF  ( QUIT  .EQ.  1 ) THEN 

SHOLES 

1 30 

17  1 

OPEN(UNIT=8 , FILE=PFN( 1 :GETLEN(PFN) ) , FORM= ' FORMATTED ' , 

SHOLES 

131 

172 

+ ACCESS='SEQUENTIAL' , STATUS= ' NEW ' ) 

SHOLES 

132 

173 

500 

FORMAT  (1X,4(  1X,A3)) 

SHOLES 

133 

174 

DO  800  N = 1 ,HTOT 

SHOLES 

134 

175 

WRITE  ( 8 , 500  ) (HOLE(N, Y1 ) , Yl=l,4) 

SHOLES 

135 

178 

600 

CONTINUE 

SHOLES 

1 38 

177 

ENDFILE(8) 

SHOLES 

137 

178 

CALL  PF  ( 'REPLACE' ,0,PFN(1 :GETLEN(PFN) >> 

SHOLES 

1 38 

WARNING* 

179 

NUMBER  OF  ARGUMENTS  IN  REFERENCE  TO  _PF  IS  NOT  CONSISTENT 
CLOSE(8,STATUS='DELETE’ > 

SHOLES 

139 

180 

PRINT* 

SHOLES 

140 

181 

PRINT*, 'DATA  HAS  BEEN  STORED  AND  PROGRAM  TERMINATED' 

SHOLES 

141 

182 

END  IF 

SHOLES 

142 

183 

IF(  ABORT  EQ.  1 ) THEN 

SHOLES 

1 43 

184 

PRINT* 

SHOLES 

144 

IBS 

PRINT*,  'PROGRAM  HAS  BEEN  ABORTED' 

SHOLES 

1 45 

188 

PRINT*,'  NO  DATA  HAS  BEEN  STORED  !!!' 

SHOLES 

148 

187 

END  IF 

SHOLES 

1 47 

188 

STOP 

SHOLES 

148 

189 

END 

SHOLES 

149 
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-V.^RUBLE 

MAP-- 

(LO=A) 

-NAME ADDRESS 

--BLOCK 

-PROPERTIES 

TYPE 

---SIZE 

ABORT 

1 05  4B 

INTEGER 

AFLAC 

2B 

/ INITILN/ 

REAL 

ANSWER 

1 05  5B 

INTEGER 

BLDC 

OB 

/ INITILC/ 

CHAR*5 

FERR 

6 8B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREGA 

4B 

/ INITILN/ 

REAL 

50 

FTOT 

47B 

/ INITILN/ 

INTEGER 

HERR 

IB 

/HOLEN/ 

INTEGER 

HOLE 

OB 

/HOLEC/ 

CHAR*3 

140 

HTOT 

OB 

/HOLEN/ 

INTEGER 

lERR 

1 06  1 B 

INTEGER 

LINE 

NONE 

UNUSED/*S* 

INTEGER 

N 

1 0 5 7B 

INTEGER 

NROOMS 

1 2 4 4B 

/ROOMN/ 

INTEGER 

OLDFI LE 

1 056B 

INTEGER 

PFN 

1 0 6 2B 

CHAR*7 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

QUIT 

1 05  3B 

INTEGER 

RAREA 

1 2 45B 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

Y1 

1 060B 

INTEGER 

Y2 

NONE 

UNUSED/ *S* 

INTEGER 

-SYMBOLIC  CONSTANTS--/ LO=A) 

-NAME TYPE VALUE 


FMAX 

INTEGER 

50 

HMAX 

INTEGER 

35 

RMAX 

INTEGER 

20 

-PROCEDURES--(LO=A) 


NAME 

--TYPE 

---ARCS--- 

---CLASS 

-NAME 

---TYPE 

ARCS  -- 

---CLASS 

DATAIN 

2 

SUBROUTINE 

LHOLE 

0 

SUBROUTINE 

ERROR 

1 

SUBROUTINE 

MANIP 

2 

SUBROUTINE 

GETLEN 

INTEGER 

1 

FUNCTION 

PF 

5 

SUBROUTINE 

STATEMENT  LABELS- -( LO=A ) 


LABEL- 

ADDRESS--- 

---PROPERTIES DEF 

100 

2 IB 

60 

200 

47B 

72 

250 

166B 

1 1 1 

300 

2 44B 

144 

-LABEL 

-ADDRESS 

--PROPERTIES- 

---DEF 

400 

25  6B 

1 50 

500 

6 0 6B 

FORMAT 

173 

600 

INACTIVE 

DO-TERM 

1 7 6 

-ENTRY  POINTS--(LO=A> 
-NAME- --ADDRESS --ARCS 

SHOLES  14B  0 


113 


5 
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-I/O  UNITS--(LO=A) 

-NAME---  PROPERTIES 

TAPEl  FMT/SEQ 
TAPE6  AUX/FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH  1045B  = 565 

CM  LABELLED  COMMON  LENGTH  1436B  = 798 


CM  STORAGE  USED 
COMPILE  TIME 

63000B  = 26112 

0.270  SECONDS 

2 

TRIVIAL 

ERRORS 

IN 

SHOLES 

1 

WARNING 

ERROR 

IN 

SHOLES 

114 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 

13 

14 

15 
1 6 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


SUBROUTINE  DATAIN  ( INSERT , L I NE ) 


SHOLES 
***t*COMR 

COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  ***COMR 

•««»«»*»»»»»»»«»»*»**»«*»»***»»*****»**»t****»******************»**«****COMR 
INTEGER  RMAX  COMR 

PARAMETER  (RMAX  = 20)  COMR 

COMMON  /ROOMN/  ROOMIRMAX  + 6,  RMAX  + 6),  NROOMS , RAREA(RMAX)  COMR 

INTEGER  NROOMS  COMR 

REAL  ROOM  COMR 

*****<i****»**«***«**************lt***lt*1t<I***tt*)t*iliili*«<i1t**<i**lt*««r*****it**QQI>fi^ 

»»»»**»»«»*»*****»**»*»***«»»**»***<i*************»******»**********»**  COMH 
» COMMON  FOR  DATABASE  OF  LOCATIONS  OF  DOORS  AND  WINDOWS  ***COMH 

*<**«**«*****«********«****«i*******«r««*«;*it****lt*****«**»***«««4it)****«  * COMH 
INTEGER  HMAX 
PARAMETER  (HMAX  = 35) 

COMMON  /HOLEN/  HTOT , HERR 
COMMON  /HOLEC/  HOLE(HMAX,4) 

INTEGER  HTOT,  HERR 
CHARACTER  * 3 HOLE 


DESCRIPTION 

OF  ARRAYS 

ROOM  IDENTIFICATION 

APERTURE  ID 

DIRECTION 

FROM  ROOM 

TO  ROOM 

HOLE(X, 1) 
A3 

HOLE (X  , 2 ) 
A3 

HOLE(X, 3) 
A3 

HOLE (X , 4) 
A3 

tmiiitittttt******* 
t*  *t 

INTEGER  ANSWER , LOK , DOK ,NOK , CETLEN , VAL , 
CHARACTER  *3  D I R , FROM , TO , ID 
200  PRINT* 

PRINT*,  'ENTER  DIRECTION  (E.  G.  ' ' LR  ' ' ) 
REWIND  1 

READd  , * , END  = 2 0 0 ) DIR 
IF  ((DIR  ,NE.  'LR') 

+ .AND.  (DIR  .NE.  ' FB ‘ ) 

+ .AND.  (DIR  NE.  ’ UD ' ) ) THEN 

PRINT*,  'DIRECTION  MUST  BE  ' ' LR ' ' OR 
PRINT* , 'TRY  AGAIN!  I I ' 

GOTO  200 
END  IF 

HOLE(LINE, 1)  = DIR 


INSERT, LINE ,V 


FB 


OR  " UD  ' 


300 


ENTER  "FROM"  (E.C. 


PRINT* 

PRINT* 

REWIND  1 

READd  ,*,END  = 3Q0)  FROM 
LOK  = 0 
DOK  = 0 
NOK  = 0 

IF  (GETLEN(FROM) 

LOK  = 1 
END  IF 

IF  (FROMdd)  .EQ 
V = VAL(FROM(2 
IF  ( (V  . GE  . 1 ) 

DOK  = 1 
END  IF 
END  IF 

IF  (dCHAR(FROMd;  D) 
.AND.  ( ICHAR(FROM(l 


02 


OR  • 'D1 


EQ.  2)  THEN 


'D' 
2 ) ) 
.AND. 


) THEN 


(V  LE.  6) ) THEN 


. 5 0 
1 

3 

4 

5 

6 

7 

8 
9 

10 

1 

2 

3 


GE  . 
1 ) ) 


1 6 ) 

• LE. 


25) 


COMH 

4 

COMH 

5 

COMH 

6 

COMH 

7 

COMH 

3 

COMH 

9 

COMH 

10 

COMH 

11 

COMH 

12 

COMH 

1 3 

COMH 

14 

COMH 

15 

COMH 

1 6 

COMH 

17 

COMH 

18 

19 

20 

SHOLES 

153 

SHOLES 

154 

SHOLES 

1 55 

SHOLES 

156 

SHOLES 

1 57 

SHOLES 

158 

SHOLES 

159 

SHOLES 

160 

SHOLES 

1 61 

SHOLES 

162 

SHOLES 

163 

SHOLES 

164 

SHOLES 

165 

SHOLES 

166 

SHOLES 

167 

SHOLES 

168 

SHOLES 

169 

SHOLES 

170 

SHOLES 

171 

SHOLES 

172 

SHOLES 

1 73 

SHOLES 

174 

SHOLES 

1 75 

SHOLES 

176 

SHOLES 

1 77 

SHOLES 

178 

SHOLES 

1 79 

SHOLES 

1 80 

SHOLES 

181 

SHOLES 

182 

SHOLES 

183 

SHOLES 

184 

SHOLES 

1 85 
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85 

+ 

.AND.  ( ICHAR( FROM( 2 : 2) ) . GE . 18) 

SHOLES 

188 

88 

+ 

.AND.  (ICHAR(FROM(2;2))  .LE.  25) 

SHOLES 

187 

87 

+ 

AND.  (GETLEN(FROM)  . EQ . 2))  THEN 

SHOLES 

188 

88 

V = VAUFROM) 

SHOLES 

189 

89 

IF  ((V  .GE.  1)  .AND.  (V  .LE.  RMAX))  THEN 

SHOLES 

190 

70 

NOK  = 1 

SHOLES 

191 

71 

END  IF 

SHOLES 

192 

72 

END  IF 

SHOLES 

193 

73 

IF  ((LOK  EQ.  1)  .AND.  ((DOK  .EQ.  1 ) .OR.  (NOK 

.EQ. 

1)))  THEN 

SHOLES 

194 

74 

HOLE (LINE, 2)  = FROM 

SHOLES 

1 95 

75 

ELSE 

SHOLES 

198 

78 

PRINT* 

SHOLES 

1 97 

77 

PRINT*,  'INCORRECT  ENTRY.  TRY  AGAIN!!' 

SHOLES 

198 

78 

GOTO  300 

SHOLES 

1 99 

79 

END  IF 

SHOLES 

200 

80  * 

SHOLES 

201 

81  400 

PRINT* 

SHOLES 

202 

82 

PRINT*,  'ENTER  "TO"  (E.G.  ''02''  OR  ''Dl'')' 

SHOLES 

203 

83 

REWIND  1 

SHOLES 

204 

84 

READ(1,*,END=400)  TO 

SHOLES 

205 

85 

LOK  = 0 

SHOLES 

208 

88 

DOK  = 0 

SHOLES 

207 

87 

NOK  = 0 

SHOLES 

208 

88 

IF  (GETLEN(TO)  EQ.  2)  THEN 

SHOLES 

209 

89 

LOK  = 1 

SHOLES 

2 1 0 

90 

END  IF 

SHOLES 

2 11 

91 

IF  (TO(l  ; 1)  .EQ.  'D' ) THEN 

SHOLES 

212 

92 

V = VAL(TO(2 : 2 ) ) 

SHOLES 

2 13 

93 

IF  ((V  .GE.  1)  .AND.  (V  .LE.  8))  THEN 

SHOLES 

214 

94 

DOK  = 1 

SHOLES 

2 1 5 

95 

END  IF 

SHOLES 

2 18 

98 

END  IF 

SHOLES 

2 17 

97 

IF  (( ICHAR(TO(l ; 1)  ) . GE . 18) 

SHOLES 

218 

98 

+ 

AND.  ( ICHAR(TO( 1 : 1 ) ) .LE.  25) 

SHOLES 

2 19 

99 

+ 

.AND.  ( ICHAR(TO(2 ; 2) ) . GE . 18) 

SHOLES 

220 

1 00 

+ 

.AND.  ( ICHAR(TO(2 : 2 ) ) .LE.  25) 

SHOLES 

221 

10  1 

+ 

.AND.  (GETLEN(TO)  . EQ . 2))  THEN 

SHOLES 

222 

102 

V = VAL  (TO) 

SHOLES 

223 

103 

IF  ((V  .GE.  1)  .AND.  (V  .LE.  RMAX))  THEN 

SHOLES 

224 

104 

NOK  = 1 

SHOLES 

225 

105 

END  IF 

SHOLES 

228 

108 

END  IF 

SHOLES 

227 

107 

IF  ((LOK  .EQ.  1)  .AND.  ((DOK  . EQ . 1)  .OR.  (NOK 

.EQ. 

1)))  THEN 

SHOLES 

228 

108 

HOLE  (LINE ,3)  = TO 

SHOLES 

229 

109 

ELSE 

SHOLES 

230 

110 

PRINT* 

SHOLES 

231 

111 

PRINT*,  'INCORRECT  ENTRY.  TRY  AGAIN!!' 

SHOLES 

232 

112 

GOTO  400 

SHOLES 

233 

113 

END  IF 

SHOLES 

234 

1 14 

IF(FROM  .EQ.  TO)  THEN 

SHOLES 

235 

115 

PRINT* 

SHOLES 

238 

118 

PRINT*,  'INCORRECT  ENTRY!!' 

SHOLES 

237 

117 

PRINT*,  '"FROM"  CANNOT  EQUAL  "TO"' 

SHOLES 

238 

118 

PRINT*,  'CHECK  YOUR  DATA  AND  REENTER  "FROM" 

AND  " 

TO"  ' 

SHOLES 

239 

119 

PRINT* 

SHOLES 

240 

120 

GOTO  300 

SHOLES 

241 

12  1 

END  IF 

SHOLES 

242 

122 

IF  ((FROM(l;l)  . EQ . 'D'  ) .AND.  (TO(l:l)  . EQ . 

'D'  )) 

THEN 

SHOLES 

2 ^ i 

123 

PRINT* 

SHOLES 

244 

124 

PRINT*,  'INCORRECT  ENTRY!!' 

SHOLES 

245 

125 

PRINT*,  '"FROM"  AND  "TO"  CANNOT  BOTH  CONTAIN 

"D"  ' 

SHOLES 

248 

128 

PRINT*,  ' CHECK  YOUR  DATA  AND  REENTER  "FROM"  AND  "TO"' 

SHOLES 

247 

127 

PRINT* 

SHOLES 

248 

128 

GOTO  300 

SHOLES 

249 
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129 

END  IF 

SHOLES 

250 

1 30 

ft 

SHOLES 

2 51 

13  1 

500 

PRINT* 

SHOLES 

252 

132 

PRINT*,  'ENTER  HOLE 

• ' ID  • ' 

(E.G.  ■ 'WA' ■ OR  ■ 'DA' ' ) ‘ 

SHOLES 

z S 3 

133 

REWIND  1 

SHOLES 

254 

134 

READ  ( 1 , * , END=500 ) 

ID 

SHOLES 

2 55 

135 

IF  (( ( ID(  1 ; 1)  ,EQ. 

‘D  ■ ) 

.OR.  ( ID(1:1)  .EQ.  'U'  )) 

SHOLES 

256 

1 36 

+ AND.  ( ICHARCID 

(2:2)) 

.LE.  58  ) 

SHOLES 

257 

137 

+ AND,  ( ICHARCID 

(2:2)) 

.GE.  33  ))  THEN 

SHOLES 

250 

1 38 

HOLE(LINE,4)  = ID 

SHOLES 

259 

139 

ELSE 

SHOLES 

2o0 

1 40 

GOTO  500 

SHOLES 

261 

14  1 

END  IF 

SHOLES 

262 

1 42 

ft 

SHOLES 

2 63 

143 

RETURN 

SHOLES 

264 

144 

END 

SHOLES 

265 

VARIABLE 

MAP-- 

(LO=A) 

NAME---ADDRESS 

--BLOCK 

-PROPERTIES 

TYPE 

ANSWER 

NONE 

UNUSED/OS* 

INTEGER 

DIR 

7 2 7B 

CHAR*3 

DOK 

7 2 4B 

INTEGER 

FROM 

730B 

CHAR*3 

HERR 

IB 

/HOLEN/ 

INTEGER 

HOLE 

OB 

/HOLEC/ 

CHAR*3 

HTOT 

OB 

/HOLEN/ 

INTEGER 

ID 

732B 

CHAR*3 

INSERT 

1 

DUMMY-ARG 

UNUSED 

INTEGER 

LINE 

2 

DUMMY-ARG 

INTEGER 

LOK 

7 2 3B 

INTEGER 

NOK 

7 2 5B 

INTEGER 

NROOMS 

1 244B 

/ROOMN/ 

INTEGER 

RAREA 

1 2 45B 

/ROOHN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

TO 

731B 

CHAR*3 

V 

726B 

INTEGER 

-SYMBOLIC  CONSTANTS--(LO=A) 


-NAME TYPE VALUE 

HMAX  INTEGER  35 

RMAX  INTEGER  20 


-PROCEDURES--(LO=A) 

-NAME TYPE ARCS CLASS 

GETLEN  INTEGER  1 FUNCTION 

ICHAR  INTEGER  1 INTRINSIC 

VAL  INTEGER  1 FUNCTION 


-STATEMENT  LABELS-- ( LO=A ) 


BEL- 

ADDRESS--- 

---PROPERTIES DEF 

200 

7B 

34 

300 

46B 

47 

400 

203B 

81 

500 

402B 

131 
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-ENTRY  POINTS--(LO=A) 

-NAME-- -ADDRESS-- ARCS 

DATAIN  5B  2 


-I /O  UNITS--(LO=A) 
-NAME PROPERTIES 

TAPEl  FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


735B  = 477 

1345B  = 741 

61000B  = 25068 

0.257  SECONDS 
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1 SUBROUTINE  MANIP  (QUIT, ABORT) 

2 ••«>iik*(i<i***««*«lt*ik**iit**lk***«ft*«:lt****tl«i********«**«**«**<i*4i*lt«iii<k*****i 

3 COMMON  FOR  DATABASE  OF  LOCATIONS  OF  DOORS  AND  WINDOWS 

INTEGER  HMAX 
PARAMETER  (HMAX  = 35) 

COMMON  /HOLEN/  HTOT , HERR 
COMMON  /HOLEC/  HOLE(HMAX,4) 

INTEGER  HTOT,  HERR 


CHARACTER  * 3 HOLE 


4 

5 

6 

7 

8 
9 

10 

1 1 • 

12  » 

13  • 

1 4 » 

15  * 

U » 

17  » 

18  * 

19  * 

22  INTEGER  ABORT , ANSWER , DOK , FLAG  1 , LOK ,N ,NOK , OK , OKI ,OK2 , QUIT, INSERT 

23  INTEGER  TEMP , V , X , Y , COMMAND 

24  CHARACTER  * 3 DIR,  FROM,  TO 

25  * 


DESCRIPTION 

OF  ARRAYS 

ROOM  IDENTIFICATION 

APERTURE  ID 

DIRECTION 

FROM  ROOM 

TO  ROOM 

HOLE(X,  1) 
A3 

HOLE (X , 2 ) 
A3 

HOLE(X, 3) 
A3 

HOLE(X,4) 

A3 

28  10 

FLAGl  = 

0 

27 

PRINT* 

28 

PRINT* , 

'CHOOSE' 

29 

PRINT* , 

' ( 1 ) 

30 

PRINT* , 

' (2) 

31 

PRINT* , 

' (3) 

32 

+ 

' PROGRAM 

33 

PRINT* , 

1 

34 

+ 

' STORING 

35 

PRINT* , 

'ENTER  A 

38 

PRINT* 

37 

REWIND 

1 

38 

READd  , 

* ,END=10) 

DISPLAY  LINE  OF  DATA 
INSERT  LINE  INTO  FILE 
DELETE  LINE 


DATA' 

NUMBER 


(4)  DISPLAY  ALL  LINES' 

(5)  APPEND  LINES  OF  DATA' 

(6)  STORE  DATA  AND  EXIT  ' 

(7)  EXIT  PROGRAM  WITHOUT 


39  * 

40  *- 

41  ** 

42  ♦- 

43 

44  * 

45  ** 
48 

47 

48 

49  * 

50  ** 

51 

52  10 

53 

54 

55 
58 

57  * 

58  ** 

59 
80 
81 
82 

83 

84 


* DISPLAY  LINE  *** 

IF  ( COMMAND  . EQ . 1 ) THEN 

* INDICATE  EMPTY  DATA  FILE 

IF  ( HTOT  .EQ.  0 ) THEN 
PRINT* 

PRINT*,  'DATA  FILE  IS  EMPTY  M!' 

* ENTER  NUMBER  OF  LINE  TO  BE  DISPLAYED 

ELSE 

0 PRINT* 

PRINT*,  'SPECIFY  THE  NUMBER  OF  THE  LINE  TO  BE  DISPLAYED 
PRINT*,  ' ( ENTER  "0"  TO  ESCAPE  DISPLAY  MODE  )' 

REWIND  1 

READd  ,*,END  = 100)  N 

* CHECK  VALIDITY  OF  LINE  NUMBER 

IF  ( (N  .GT.  HTOT)  .OR.  (N  . LT . 0)  ) THEN 


PRINT* 
PRINT* , 
PRINT*, 

GOTO  100 


INCORRECT  NUMBER  !!!!!!  TRY  AGAIN  !!! 

-OR-  ENTER  "0"  TO  ESCAPE  FROM  ' 
"DISPLAY"  MODE' 


3HOLES 

2 8 8 

»COMH 

1 

‘COMH 

; 

*COMH 

5 

COMH 

4 

COMH 

5 

COMH 

8 

COMH 

7 

COMH 

8 

COMH 

9 

COMH 

1C 

COMH 

1 1 

COMH 

1 2 

COMH 

13 

COMH 

! 4 

COMH 

15 

COMH 

1 8 

COMH 

17 

COMH 

18 

'COMH 

19 

'COMH 

20 

SHOLES 

288 

SHOLES 

289 

SHOLES 

270 

SHOLES 

27  1 

SHOLES 

2 72 

SHOLES 

273 

SHOLES 

274 

SHOLES 

275 

SHOLES 

278 

SHOLES 

277 

SHOLES 

278 

SHOLES 

279 

SHOLES 

280 

SHOLES 

281 

SHOLES 

282 

SHOLES 

283 

SHOLES 

284 

SHOLES 

285 

SHOLES 

288 

SHOLES 

287 

SHOLES 

2 88 

SHOLES 

289 

SHOLES 

2 90 

SHOLES 

291 

SHOLES 

292 

SHOLES 

293 

SHOLES 

294 

SHOLES 

295 

SHOLES 

298 

SHOLES 

297 

SHOLES 

298 

SHOLES 

299 

SHOLES 

300 

SHOLES 

301 

SHOLES 

302 

SHOLES 

303 

SHOLES 

304 

SHOLES 

305 

SHOLES 

308 

SHOLES 

307 

SHOLES 

308 

SHOLES 

309 

SHOLES 

3 10 
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45  PACE 


1 1 


66 

tut 

ABORT  'DISPLAY'  MODE 

SHOLES 

67 

ELSE  IF  ( N .EQ.  0 ) THEN 

SHOLES 

68 

PRINT* 

SHOLES 

69 

PRINT*,  ' "DISPLAY"  MODE  ABORTED  !!!' 

SHOLES 

70 

t 

SHOLES 

71 

tt  it 

DISPLAY  LINE  OF  DATA 

SHOLES 

72 

ELSE  IF  ( (N  .GT.  0)  .AND.  <N  .LE.  HTOT)  ) THEN 

SHOLES 

73 

PRINT* 

SHOLES 

74 

CALL  DISPLAY!  N,  COMMAND) 

SHOLES 

75 

t 

SHOLES 

76 

END  IF 

SHOLES 

77 

END  IF 

SHOLES 

78 

END  IF 

SHOLES 

79 

* 

SHOLES 

80 

t 

SHOLES 

81 

tt  it 

INSERT  LINE  *»* 

SHOLES 

82 

t 

SHOLES 

83 

IF  ( COMMAND  EQ.  2 ) THEN 

SHOLES 

84 

* 

SHOLES 

85 

ttt 

INDICATE  EMPTY  DATA  FILE 

SHOLES 

86 

IF  ( HTOT  .EQ.  0 ) THEN 

SHOLES 

87 

PRINT* 

SHOLES 

88 

PRINT*,  'DATA  FILE  IS  EMPTY  !!!' 

SHOLES 

89 

t 

SHOLES 

90 

ttt 

REQUEST  NUMBER  OF  LINE  BEFORE  WHICH  INSERTION  IS  TO  BE  MADE 

SHOLES 

91 

ELSE 

SHOLES 

92 

200 

PRINT* 

SHOLES 

93 

PRINT*,  'SPECIFY  NUMBER  OF  LINE  BEFORE  WHICH  A 

NEW  LINE  IS  ' 

, SHOLES 

94 

+ 'TO  BE  INSERTED' 

SHOLES 

95 

PRINT*,  ' ( ENTER  "0"  TO  ESCAPE  "INSERTION" 

MODE  ) ' 

SHOLES 

96 

REWIND  1 

SHOLES 

97 

READ! 1 , * , END=200)  N 

SHOLES 

98 

* 

SHOLES 

99 

ttt 

CHECK  FOR  VALID  LINE  NUMBER 

SHOLES 

1 00 

IF  ! ! N .LT.  0 ) .OR.  ! N .GT.  HTOT  ) ) THEN 

SHOLES 

101 

PRINT* 

SHOLES 

102 

PRINT*,  'INCORRECT  LINE  NUMBER  !'.!' 

SHOLES 

103 

PRINT*,  ' TRY  AGAIN  !!!  -OR-  ENTER  "0" 

TO  ESCAPE' , 

SHOLES 

104 

+ '"INSERTION"  MODE' 

SHOLES 

105 

GOTO  200 

SHOLES 

106 

t 

SHOLES 

107 

ttt 

ABORT  INSERTION  MODE 

SHOLES 

1 08 

ELSE  IF  ! N .EQ.  0 ) THEN 

SHOLES 

109 

PRINT* 

SHOLES 

1 10 

PRINT*,  ' "INSERTION"  MODE  ABORTED' 

SHOLES 

11  1 

t 

SHOLES 

112 

t tt 

MAKE  ROOM  FOR  NEW  LINE  OF  DATA 

SHOLES 

113 

ELSE  IF  ! !N  .GT.  0)  AND.  !N  LE.  HTOT)  ) THEN 

SHOLES 

114 

DO  230  X = HTOT,N,-l 

SHOLES 

115 

DO  210  Y = 1,4 

SHOLES 

116 

HOLE!X+l , Y)  = HOLE!X ,Y) 

SHOLES 

117 

210 

CONTINUE 

SHOLES 

118 

230 

CONTINUE 

SHOLES 

119 

t 

SHOLES 

1 20 

ttt 

ENTER  DATA  FOR  NEW  LINE 

SHOLES 

12  1 

HTOT  = HTOT  + 1 

SHOLES 

122 

CALL  DATAIN  ! 1 ,N) 

SHOLES 

123 

t 

SHOLES 

124 

PRINT* 

SHOLES 

125 

PRINT*,  'THE  FOLLOWING  LINE  HAS  BEEN  ADDED 

AS  LINE  ' , N 

SHOLES 

126 

CALL  DISPLAY!  N,  COMMAND) 

SHOLES 

127 

END  IF 

SHOLES 

128 

END  IF 

SHOLES 

3 1 1 
3 12 
3 1 3 
3 14 
315 
3 U 
317 
3 18 

319 

320 

321 

322 

323 

324 

325 

326 

327 

328 

329 

330 

331 

332 

333 

334 

335 
3 36 

337 

338 

339 

340 

341 

342 

343 

344 

345 
3 46 

347 

348 

349 

350 

351 

352 

353 

354 

355 

356 

357 

358 

359 

360 
36  1 

362 

363 

364 

365 

366 

367 

368 

369 

370 

371 

372 

373 

374 
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129 
1 30 
13  1 

t 

END  IF 

SKOLES 

SHOLES 

3HOLES 

j / J 

376 
3 7 7 

132 

t • R 

DELETE  LINE 

SHO  L 1 5 

5 78 

133 

SHOLES 

379 

134 

IF  ( COMMAND  EQ . 3 ) THEN 

SHOLES 

3 80 

135 

a 

SHOLES 

331 

1 36 

a a a 

INDICATE  EMPTY  DATA  FILE 

SHOLES 

382 

137 

IF  ( HTOT  EQ.  0 ) THEN 

SHOLES 

383 

1 38 

PRINT* 

SHOLES 

3 84 

139 

PRINT*,  'DATA  FILE  IS  EMPTY 

! ! ! 

■ 

SHOLES 

385 

1 40 

a 

SKOLES 

5 86 

14  1 

a a a 

READ  NUMBER  OF  LINE  TO  BE  DELETED 

SHOLES 

3 87 

1 42 

ELSE 

SHOLES 

3 98 

14  3 

300 

PRINT* 

SHOLES 

389 

1 44 

PRINT*,  'SPECIFY  THE  NUMBER 

OF 

THE 

LINE  TO 

BE 

DELETED ' 

SHOLES 

3 9C 

145 

PRINT*,  ' (ENTER  "0"  TO  ESCAPE  DELETION 

MODE) ' 

SHOLES 

■ ? 1 

1 46 

REWIND  1 

SHO  L Z S 

39Z 

147 

READ(1,*,END=300)  N 

SHOLES 

393 

1 48 

a 

SHOLES 

3 94 

149 

a a a 

CHECK  VALIDITY  OF  LINE  NUMBER 

SHOLES 

395 

150 

IF  ( (N  .GT.  HTOT  ) .OR.  ( N 

. LT.  0 

) ) THEN 

SHOLES 

396 

15  1 

PRINT* 

SHOLES 

397 

152 

PRINT*,  ' INCORRECT  NUMBER 

i I 

\ * 

SHOLES 

398 

15  3 

PRINT* , ' TRY  ACAIN  ! ! ! 

- 

OR- 

ENTER 

"0” 

TO  ESCAPE  FROM' 

, SHOLES 

399 

154 

+ '"DELETE"  MODE' 

SHOLES 

4 00 

155 

COTO  300 

SKOLES 

401 

1 56 

a 

SHOLES 

401 

157 

a a a 

ABORT  'DELETE'  MODE 

SHOLES 

403 

1 58 

ELSE  IF  ( N .EQ.  0 ) THEN 

SHOLES 

4 04 

159 

PRINT*,  ' "DELETE"  MODE  ABORTED' 

SHOLES 

405 

160 

a 

SHOLES 

406 

16  1 

a a a 

DOUBLE  CHECK  CHOICE  OF  LINE  TO  BE 

DELETED 

SHOLES 

407 

162 

ELSE  IF  ((  N .GT.  0 ) .AND. 

( N 

. LE 

. HTOT 

) ) 

THEN 

SHOLES 

406 

16  3 

PRINT* 

SHOLES 

409 

164 

PRINT* , 'DOUBLE  CHECK  ! !!  ' 

SHOLES 

4 10 

165 

PRINT*,  ' DO  YOU  WANT 

TO 

DELETE  THE 

FOLLOWING  LINE? ; ' 

SHOLES 

4 1 1 

166 

CALL  DISPLAY!  N,  COMMAND) 

SHOLES 

4 12 

167 

305 

PRINT*,  ' ENTER  (1)  YES 

OR 

(2)  NO' 

SHOLES 

4 13 

168 

REWIND  1 

SHOLES 

4 14 

169 

READ( 1 , * , END=305)  ANSWER 

SHOLES 

4 15 

170 

a 

SHOLES 

4 16 

17  1 

a a a 

DELETE  LINE 

SHOLES 

417 

172 

IF  ( ANSWER  EQ.  1 ) THEN 

SHOLES 

4 18 

173 

DO  330  X = N,  HTOT  - 1 

SHOLES 

4 1 9 

174 

DO  310  Y = 1,4 

SHOLES 

420 

175 

HOLE(X,Y)  = HOLE(X+l,Y) 

SHOLES 

421 

176 

310 

CONTINUE 

SHOLES 

422 

177 

330 

CONTINUE 

SHOLES 

423 

178 

HTOT  = HTOT  - 1 

SHOLES 

4 24 

179 

PRINT* 

SHOLES 

425 

1 BO 

PRINT*,  'LINE  t ',N,'  DELETED' 

SHOLES 

426 

18  1 

END  IF 

SHOLES 

427 

1 82 

a 

SHOLES 

428 

183 

END  IF 

SHOLES 

47  9 

184 

END  IF 

SHOLES 

4 30 

185 

END  IF 

SHOLES 

431 

186 

a 

SHOLES 

4 32 

187 

a 

SHOLES 

433 

188 

a a a 

DISPLAY  ALL  DATA  *** 

SHOLES 

4 34 

189 

a 

SHOLES 

435 

190 

IF  ( COMMAND  .EQ.  4 ) THEN 

SHOLES 

4 36 

19  1 

a 

SHOLES 

437 

192 

t** 

INDICATE  EMPTY  DATA  FILE 

SHOLES 

4 38 

121 
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193 

IF  ( HTOT  EQ.  0 ) THEN 

SHOLES 

439 

194 

PRINT* 

SHOLES 

4 40 

195 

PRINT*,  -DATA  FILE  IS  EMPTY  !!!' 

SHOLES 

44  1 

1 94 

t 

SHOLES 

442 

197 

* * * 

DISPLAY  DATA 

SHOLES 

443 

198 

ELSE 

SHOLES 

444 

199 

PRINT* 

SHOLES 

445 

200 

CALL  DISPLAY!  N,  COMMAND) 

SHOLES 

444 

20  1 

* 

SHOLES 

447 

202 

END  IF 

SHOLES 

448 

203 

END  IF 

SHOLES 

449 

204 

* 

SHOLES 

450 

205 

t 

SHOLES 

451 

204 

* * * 

ADD  DATA  *** 

SHOLES 

452 

207 

* 

SHOLES 

453 

208 

IF  ( COMMAND  . EQ . 5 ) THEN 

SHOLES 

454 

209 

A 

SHOLES 

455 

2 10 

AAA 

ENTER  DATA 

SHOLES 

454 

21  1 

500 

HTOT  = HTOT  + 1 

SHOLES 

457 

2 12 

CALL  DATA  IN  (O.HTOT) 

SHOLES 

458 

213 

510 

PRINT* 

SHOLES 

459 

2 14 

PRINT*.  'DO  YOU  WANT  TO  ENTER  MORE  DATA? 

! 1) 

YES  !2) 

NO  ' 

SHOLES 

440 

215 

PRINT*,  ■ ENTER  A NUMBER  !!!‘ 

SHOLES 

441 

2 14 

REWIND  1 

SHOLES 

442 

217 

READ! 1 , * , END=510)  ANSWER 

SHOLES 

443 

2 18 

A 

SHOLES 

4 44 

219 

AAA 

CHECK  VALIDITY  OF  NUMBER 

SHOLES 

445 

220 

IF  ! ! ANSWER  .NE.  1 ) AND.  ! ANSWER 

• NE  . 

2 ) 

) THEN 

SHOLES 

4 66 

22  1 

GOTO  510 

SHOLES 

447 

222 

A 

SHOLES 

448 

223 

AAA 

ENTER  MORE  DATA 

SHOLES 

449 

224 

ELSE  IF  ! ANSWER  . EQ . 1 ) THEN 

SHOLES 

470 

225 

GOTO  500 

SHOLES 

471 

224 

A 

SHOLES 

472 

227 

AAA 

DISCONTINUE  DATA  ENTRY 

SHOLES 

473 

228 

ELSE  IF  ! ANSWER  EQ.  2 ) THEN 

SHOLES 

4 74 

229 

PRINT* 

SHOLES 

475 

230 

PRINT*,  'DATA  ENTRY  DISCONTINUED' 

SHOLES 

474 

231 

A 

SHOLES 

477 

232 

END  IF 

SHOLES 

478 

233 

END  IF 

SHOLES 

479 

234 

A 

SHOLES 

480 

235 

A 

SHOLES 

481 

234 

AAA 

STORE  DATA  AND  PROGRAM  *** 

SHOLES 

482 

237 

A _ . _ 

SHOLES 

483 

238 

IF  ! COMMAND  .EQ.  4 ) THEN 

SHOLES 

484 

239 

400 

PRINT* 

SHOLES 

485 

240 

PRINT* , 'DOUBLE  CHECK  ! ! ! ' 

SHOLES 

484 

24  1 

PRINT*,  ' DO  YOU  YOU  WANT  TO  STORE 

THIS 

DATA 

AND  END 

PROG  ' 

SHOLES 

487 

242 

PRINT*,  ' NOTE.  STORING  THIS  DATA  WILL  WIPE  OUT  ANY  OLD 

FILE 

SHOLES 

488 

243 

PRINT*,  ' OF  THE  SAME  NAME  !!!' 

SHOLES 

489 

244 

PRINT*,  ' ENTER  A NUMBER;  !1) 

YES 

! 2) 

NO  ' 

SHOLES 

490 

245 

REWIND  1 

SHOLES 

491 

244 

READ!1 ,*,END=400)  ANSWER 

SHOLES 

492 

247 

A 

SHOLES 

493 

248 

AAA 

SET  FLAG  FOR  STORING  DATA  IN  THE  MAIN  PROGRAM 

SHOLES 

494 

249 

IF  ! ANSWER  . EQ . 1 ) THEN 

SHOLES 

495 

250 

QUIT  = 1 

SHOLES 

4 94 

25  1 

RETURN 

SHOLES 

497 

252 

A 

SHOLES 

498 

253 

AAA 

ABORT  'STORING'  MODE 

SHOLES 

499 

254 

ELSE  IF  ! ANSWER  .EQ.  2 ) THEN 

SHOLES 

500 

255 

PRINT* 

SHOLES 

SOI 

254 

PRINT*,  ■ "STORING"  MODE  DISCONT 

INUED' 

SHOLES 

502 

122 
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257 

• 

SHOLES 

503 

258 

«•*  CHECK  VALIDITY  OF  ANSWER 

SHOLES 

5 04 

259 

ELSE  IF  ( ( ANSWER  .NE.  1 ) .AND.  ( ANSWER  NE.  2 ) 

) THEN 

SHOLES 

505 

280 

GOTO  800 

SHOLES 

5 06 

28  1 

% 

SHOLES 

507 

282 

END  IF 

SHOLES 

5 08 

283 

END  IF 

SHOLES 

509 

284 

% 

SHOLES 

5 10 

Qwnr 

5 1 1 

288 

*»»  END  PROGRAM  WITHOUT  STORING  DATA  *** 

SHOLES 

5 12 

^11 

Q14HT  PQ 

5 13 

288 

IF  ( COMMAND  . EQ . 7 ) THEN 

SHOLES 

5 14 

289 

700  PRINT* 

SHOLES 

515 

270 

PRINT* , ' DOUBLE  CHECK  ! ! ! ' 

SHOLES 

5 16 

27  1 

PRINT*,  ' DO  YOU  WANT  TO  END  THIS  PROGRAM 

SHOLES 

5 1 7 

111 

+ 'WITHOUT  STORING  DATA?' 

SHOLES 

5 18 

273 

PRINT*,  ' ENTER  A NUMBER:  (1)  YES  (2)  NO' 

SHOLES 

5 1 9 

274 

REWIND  1 

SHOLES 

520 

275 

READ(1,*,END=700)  ANSWER 

SHOLES 

521 

278 

SHOLES 

5 22 

in 

***  SET  FLAG  FOR  ABORTING  PROGRAM  IN  THE  MAIN  PROGRAM 

SHOLES 

523 

278 

IF  ( ANSWER  EQ.  1 ) THEN 

SHOLES 

524 

279 

ABORT  = 1 

SHOLES 

525 

280 

RETURN 

SHOLES 

526 

28  1 

ft 

SHOLES 

527 

282 

***  ABORT  'STORING'  MODE 

SHOLES 

5 28 

263 

ELSE  IF  ( ANSWER  . EQ . 2 ) THEN 

SHOLES 

529 

284 

PRINT* 

SHOLES 

530 

285 

PRINT*,  ' "ABORTION"  MODE  DISCONTINUED' 

SHOLES 

531 

288 

ft 

SHOLES 

532 

287 

***  CHECK  VALIDITY  OF  ANSWER 

SHOLES 

533 

288 

ELSE  IF  ( ( ANSWER  .NE.  1 ) .AND.  ( ANSWER  . NE . 2 ) 

) THEN 

SHOLES 

534 

289 

GOTO  700 

SHOLES 

535 

290 

ft 

SHOLES 

5 38 

29  1 

END  IF 

SHOLES 

537 

292 

END  IF 

SHOLES 

538 

293 

ft 

SHOLES 

539 

2 94 

cunT  r c 

540 

295 

***  LOOP  TO  BEGINNING  OF  'MANIP'  SUBROUTINE 

SHOLES 

541 

298 

ft 

- SHOLES 

542 

297 

GOTO  10 

SHOLES 

543 

298 

ft 

SHOLES 

544 

299 

RETURN 

SHOLES 

545 

TRIVIAL* 

NO  PATH  TO  THIS  STATEMENT 

300 

END 

SHOLES 

548 

-VARIABLE 

MAP-- 

II 

o 

-NAME ADDRESS 

--BLOCK 

-PROPERTIES 

TYPE 

ABORT 

2 

DUMMY -ARG 

INTEGER 

ANSWER 

1 400B 

INTEGER 

COMMAND 

1 405B 

INTEGER 

DIR 

NONE 

UNUSED/ *S* 

CHAR*3 

DOK 

NONE 

UNUSED/*S» 

INTEGER 

FLAGl 

1401B 

INTEGER 

FROM 

NONE 

UNUSED/ *S* 

CHAR*3 

HERR 

IB 

/HOLEN/ 

INTEGER 

HOLE 

OB 

/HOLEC/ 

CHAR*3 

HTOT 

OB 

/HOLEN/ 

INTEGER 

INSERT 

NONE 

UNUSED/ *S* 

INTEGER 

LOK 

NONE 

UNUSED/*S* 

INTEGER 

N 

1 402B 

INTEGER 

NOK 

NONE 

UNUSED/*S* 

INTEGER 

123 
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OK 

NONE 

UNUSED/*S* 

INTECER 

OKI 

NONE 

UNUSED/*S* 

INTEGER 

OK2 

NONE 

UNUSED/*S* 

INTEGER 

QUIT 

1 

DUMMY-ARC 

INTEGER 

TEMP 

NONE 

UNUSED/ *S* 

INTEGER 

TO 

NONE 

UNUSED/*S» 

CHAR*3 

V 

NONE 

UNUSED/ *S* 

INTEGER 

X 

1 403B 

INTEGER 

Y 

1 404B 

INTEGER 

SYMBOLIC  CONSTANTS--! LO=A) 

NAME TYPE 

VALUE 

HMAX  INTEGER 

35 

-PROCEDURES--(LO=A) 


-NAME 

--TYPE 

ARCS 

---CLASS 

DATAIN 

2 

SUBROUTINE 

DISPLAY 

2 

SUBROUTINE 

-STATEMENT  LABELS- -( LO=A ) 


LABEL- 

ADDRESS 

--PROPERTIES- 

---DEF 

-LABEL 

-ADDRESS 

--PROPERTIES- 

---DEF 

10 

7B 

26 

3 10 

INACTIVE 

DO-TERM 

1 76 

100 

50B 

52 

330 

INACTIVE 

DO-TERM 

177 

200 

133B 

92 

500 

43  7B 

211 

210 

INACTIVE 

DO-TERM 

117 

510 

44  3B 

213 

230 

INACTIVE 

DO-TERM 

118 

600 

S04B 

239 

300 

263B 

143 

700 

55  6B 

269 

305 

332B 

167 

-ENTRY  POINTS--(LO=A) 
-NAME ---ADDRESS-- ARCS 

MANIP  5B  2 


-I/O  UNITS--(LO=A) 
-NAME PROPERTIES 

TAPEl  FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

141  4B 

= 780 

CM  LABELLED  COMMON  LENGTH 

54B 

= 44 

CM  STORAGE  USED 

63000B 

= 26112 

COMPILE  TIME 

0.388 

SECONDS 

1 TRIVIAL  ERROR  IN 

MANIP 

124 


u 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
12 
13 
1 4 

15 

16 
17 
IS 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 


SUBROUTINE  DISPLAY  (LINE,  COMMAND)  3HOLES 

*•"  COMMON  FOR  DATABASE  OF  LOCATIONS  OF  DOORS  AND  VINDOUS  ***COMH 

INTEGER  HMAX  COMH 

PARAMETER  (HMAX  = 35)  COMH 

COMMON  /HOLEN/  HTOT , HERR  COMH 

COMMON  /HOLEC/  HOLE (HMAX, 4)  COMH 

INTEGER  HTOT,  HERR  COMH 

CHARACTER  * 3 HOLE  COMH 

* ==================================================  COMH 

» DESCRIPTION  OF  ARRAYS  COMH 

* ==================================================  COMH 

* ROOM  IDENTIFICATION  APERTURE  ID  COMH 

« - COMH 

» DIRECTION  FROM  ROOM  TO  ROOM  COMH 

» COMH 

* HOLE(X,l)  HOLE(X,2)  HOLE(E,3)  HOLE(X,4)  COMH 

* A3  A3  A3  A3  COMH 

*rt*««*****«****«<r«*******«ii>***t********«*iii*<i*ii(iiMii*******A**************«ikCOMH 

INTEGER  LINE,  COMMAND,  N SHOLES 

1000  FORMAT  (8(3X,A))  SHOLES 

2 0 0 0 FORMAT  ( 4X , I 3 , 8X , A3 , 7 X , A3 , 3X , A3 , 2X , A3 ) SHOLES 

PRINT  10  00,  'LINE  # ' , ' D IRECTI ON ' , ' FROM ’ , ' TO ' , ' ID ' SHOLES 

IF  ( COMMAND  .EQ,  4 ) THEN  SHOLES 

DO  10  N = l,HTOT  SHOLES 

PRINT  2000,  N,HOLE(N, 1) ,HOLE(N, 2) ,HOLE(N,3) ,HOLE(N,4)  SHOLES 

10  CONTINUE  SHOLES 

ELSE  SHOLES 

PRINT  2000,  LINE,HOLE(LINE,l) ,HOLE(LINE,2) ,HOLE(LINE,3) , SHOLES 

+ HOLE(LINE,4)  SHOLES 

END  IF  SHOLES 

RETURN  SHOLES 

END  SHOLES 


5 47 
1 

2 

3 

4 

5 

6 
/ 
8 
9 

1 0 
1 1 
12 
1 3 

14 

15 

16 

17 

18 

19 

20 
5 49 

550 

551 

552 

553 

554 

555 

556 

557 

558 

559 

560 

561 

562 


VARIABLE 

MAP-- 

(LO=A) 

NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

---SIZE 

COMMAND 

2 

DUMMY -ARG 

INTEGER 

HERR 

IB 

/HOLEN/ 

INTEGER 

HOLE 

OB 

/HOLEC/ 

CHAR*3 

1 40 

HTOT 

OB 

/HOLEN/ 

INTEGER 

LINE 

1 

DUMMY -ARG 

INTEGER 

N 

20  4B 

INTEGER 

-SYMBOLIC  CONSTANTS--(LO=A) 

-NAME TYPE VALUE 

HMAX  INTEGER  35 


-STATEMENT  LABELS- -( LO= A ) 


LABEL- 

ADDRESS 

--PROPERTIES--- 

-DEF 

1 0 

INACTIVE 

DO-TERM 

29 

1000 

123B 

FORMAT 

23 

20  00 

125B 

FORMAT 

24 
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--ENTRY  POINTS--(LO=A) 

-NAME ADDRESS --ARCS- -- 

DISPLAY  5B  2 


--STATISTICS-- 


PROGRAM-UNIT  LENGTH 

2108 

■ 1 36 

CM  LABELLED  COMMON  LENGTH 

54B 

> 44 

CM  STORAGE  USED 

610008 

> 25088 

COMPILE  TIME 

0 0 61 

SECONDS 

125 
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FTN  5.1+552 
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1 

INTEGER  FUNCTION  VAL(STRING) 

SHOLES 

563 

2 

c** 

RETURNS  THE  INTEGER  VALUE  OF  A STRING. 

SHOLES 

5 64 

3 

INTEGER  NUMBER,  X , L , EXP , D I GIT , GETLEN 

SHOLES 

565 

4 

CHARACTER  * <*)  STRING 

SHOLES 

5 66 

5 

L = GETLEN(STRING) 

SHOLES 

567 

6 

NUMBER  = 0 

SHOLES 

568 

7 

DO  10  X = L, 1 , -1 

SHOLES 

569 

8 

EXP  = L - X 

SHOLES 

570 

9 

DIGIT  = ICHAR(STRING(X; X)  ) - 16 

SHOLES 

571 

10 

NUMBER  = NUMBER  + D IG 1T« 1 0 * *EXP 

SHOLES 

5 72 

1 1 

10 

CONTINUE 

SHOLES 

573 

12 

VAL  = NUMBER 

SHOLES 

574 

13 

RETURN 

SHOLES 

575 

14 

END 

SHOLES 

5 76 

-VARIABLE  MAP--(LO=A) 

-NAME ADDRESS --BLOCK PROPERTIES 

TYPE 

DIGIT 

76B 

INTEGER 

EXP 

75B 

INTEGER 

L 

74B 

INTEGER 

NUMBER 

72B 

INTEGER 

STRING 

1 DUMMY-ARG 

CHAR*  < *) 

VAL 

71B 

INTEGER 

X 

73B 

INTEGER 

-PROCEDURES 

--(LO=A) 

-NAME- 

TYPE 

--ARGS--- 

---CLASS 

GETLEN 

INTEGER 

1 

FUNCTION 

ICHAR 

INTEGER 

1 

INTRINSIC 

-STATEMENT  LABELS- -( LO=A ) 
-LABEL-ADDRESS PROPERTI  ES DEF 

10  INACTIVE  DO-TERM  11 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS- -ARCS- -- 

VAL  6B  1 


-STATISTICS-- 

PROCRAM-UNIT  LENGTH  102B  = 86 

CM  STORAGE  USED  61000B  = 25088 

COMPILE  TIME  0.039  SECONDS 
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1 

INTEGER  FUNCTION  GETLEN  (STRING) 

SHOLES 

577 

2 

C 

SHOLES 

5 78 

3 

C 

DETERMINE  LENGTH  OF  STRING  EXCLUDING  ANY  BLANK  PADDING 

SHOLES 

5 79 

4 

C 

SHOLES 

5 80 

5 

C 

SHOLES 

581 

6 

C 

ARGUMENT  DEFINITIONS  -- 

SHOLES 

5 82 

7 

C 

READ  ARGUMENTS 

SHOLES 

583 

8 

C 

STRING  - STRING  WHOSE  LENGTH  IS  TO  BE  DETERMINED 

SHOLES 

5 84 

9 

C 

SHOLES 

585 

10 

CHARACTER  * (»)  STRING 

SHOLES 

5 86 

1 1 

C 

SHOLES 

587 

12 

C 

FUNCTION  PARAMETERS 

SHOLES 

5 88 

13 

CHARACTER  » 1 BLANK 

SHOLES 

589 

1 4 

PARAMETER  (BLANK  = ' ‘ ) 

SHOLES 

5 90 

IS 

C 

SHOLES 

591 

16 

C 

LOCAL  VARIABLES 

SHOLES 

592 

17 

INTEGER  NEXT 

SHOLES 

5 93 

18 

C 

SHOLES 

5 94 

19 

C 

START  WITH  THE  LAST  CHARACTER  AND  FIND  THE  FIRST  NON-BLANK 

SHOLES 

595 

20 

DO  10  NEXT  = LEN(STRING) , 1 , -1 

SHOLES 

596 

21 

IF  (STRING (NfeXT  ; NEXT)  .NE.  BLANK)  THEN 

SHOLES 

597 

22 

GETLEN  = NEXT 

SHOLES 

598 

23 

RETURN 

SHOLES 

599 

24 

END  IF 

SHOLES 

600 

25 

10  CONTINUE 

SHOLES 

601 

26 

C 

SHOLES 

602 

27 

C 

ALL  CHARACTERS  ARE  BLANKS 

SHOLES 

603 

28 

GETLEN  = 0 

SHOLES 

6 04 

29 

C 

SHOLES 

605 

30 

RETURN 

SHOLES 

6 06 

31 

END 

SHOLES 

607 

VARIABLE  MAP--(LO=A) 

NAME ADDRESS- -BLOCK PROPERTIES 

TYPE 

---SIZE 

CETLEN 

63B 

INTEGER 

NEXT 

64B 

INTEGER 

STRING 

1 DUMMY-ARG 

CHARM  *) 

-SYMBOLIC  CONSTANTS--! LO=A) 

-NAME TYPE VALUE 

BLANK  CHAR*1  ' ' 


-PROCEDURES--(LO=A) 

-NAME TYPE 

ARCS 

-CLASS 

LEN  INTEGER 

1 

INTRINSIC 

-STATEMENT  LABELS-- 

(LO=A) 

-LABEL-ADDRESS 

PROPERTIES--- 

-DEF 

10  INACTIVE 

DO-TERM 

25 

FTN  5.1+552  83/12/24 

FUNCTION  GETLEN  74/175 

. 09.11.45  PACE 
OPT  = 0 

20 

--ENTRY  POINTS--(LO=A) 
-NAME ADDRESS- -ARCS--- 

GETLEN  8B  1 


--STATISTICS-- 

PROGRAM-UNIT  LENGTH  70B  > 36 

CM  STORAGE  USED  61000B  > 25088 

COMPILE  TIME  0.037  SECONDS 
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1 SUBROUTINE  LHOLE  LHOLE 

2 * !!!!  M !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  I!  !!!!!!!!!!!  M ! LHOLE 

3 * ! ! ! ! ! ! LHOLE 

4 *!!!  LOAD  THE  CONTENTS  OF  THE  "HOLE"  FILE  INTO  THE  "HOLE"  ARRAY  MILHOLE 

5 * ! ! ! M ! LHOLE 

6 *!!!!!!!!!!!!!!!!!!!!!  I ! I ! I !!!  M !!!!!!!!!!!!!  M !!!!!!  M !!!!!!!!!!!!!  M !! L HO  L E 

7 )ii«*******««****«***«****«****«******«**«***««««**««***********«ik**«**«**C0MH 

8 ***  COMMON  FOR  DATABASE  OF  LOCATIONS  OF  DOORS  AND  WINDOWS  ***COMH 

10  INTEGER  HMAX  COMH 

11  PARAMETER  (HMAX  = 35)  COMH 

12  COMMON  /HOLEN/  HTOT,  HERR  COMH 

13  COMMON  /HOLEC/  HOLE (HMAX, 4)  COMH 

14  INTEGER  HTOT,  HERR  COMH 

15  CHARACTER  * 3 HOLE  COMH 

U * ==================================================  COMH 

17  * DESCRIPTION  OF  ARRAYS  COMH 

18  * ==================================================  COMH 

19  * ROOM  IDENTIFICATION  APERTURE  ID  COMH 

20  * COMH 

21  * DIRECTION  FROM  ROOM  TO  ROOM  COMH 

22  * - COMH 

23  * HOLE(X,l)  HOLE(X,2)  HOLE(X,3)  HOLE(X,4)  COMH 

24  * A3  A3  A3  A3  COMH 


2i  *lt**«*******4r**ti**A<l*|li*****1k*«AttD****[**A)k****i***«*********lk**A**********  COMH 
27  «******llr******«*ik*******************************«************lt*tk**ik*****COMF 


28 

* A * 

COMMON  FOR  INITIAL  PARAMETERS 

***COMF 

29 

A* 

*ft**ft*ft**ft*****ft*******ft**ft**ft****ft*******ft****ft**ftft*ft*ft***ft*ft**ft*ft  ft  COM F 

30 

INTEGER  FMAX 

COMF 

31 

PARAMETER  (FMAX  = 50) 

COMF 

32 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX), 

FERR,  COMF 

33 

$ ftot 

COMF 

34 

COMMON  /INITILC/  BLDG 

COMF 

35 

CHARACTER  * 5 BLDG 

COMF 

36 

REAL  FREQ,  AFLAC,  RFLAG,  FREQA 

COMF 

37 

INTEGER  QUALITY,  FERR,  FTOT 

COMF 

38 

39 

ft*  *« 

40 

INTEGER  CETLEN,  R,  C 

LHOLE 

41 

CHARACTER  * 7 PFN 

LHOLE 

42 

PFN  = 'B‘  II  BLDG( 1 :GETLEN(BLDG) ) II  'H' 

LHOLE 

43 

HERR  = 0 

LHOLE 

44 

CALL  PF  ( 'GET' , 0 ,PFN( 1 :GETLEN(PFN) ) , ‘RC‘ ,HERR) 

LHOLE 

45 

IF  ( HERR  .EQ.  0 ) THEN 

LHOLE 

46 

OPEN  (UNIT=3,  FILE=PFN,  FORM= ' FORMATTED ' , 

LHOLE 

47 

5 STATUS= 'OLD'  , ACCESS= ' SEQUENTIAL ' ) 

LHOLE 

48 

1000 

FORMAT  ( IX , 4(  IX , A3  ) > 

LHOLE 

49 

HTOT  = 0 

LHOLE 

50 

DO  10  R = 1 ,HMAX 

LHOLE 

51 

READ  (3,1000  , END=20)  (HOLE(R,  C)  ,C:nl , 4) 

LHOLE 

52 

HTOT  = HTOT  + 1 

LHOLE 

53 

10 

CONTINUE 

LHOLE 

54 

20 

CONTINUE 

LHOLE 

55 

C LOSE ( 3, STATUS= 'DELETE' ) 

LHOLE 

56 

ELSE  IF  ( HERR  EQ.  2 ) THEN 

LHOLE 

57 

CALL  WARNING  ( 1 ) 

LHOLE 

58 

ELSE 

LHOLE 

59 

CALL  WARNING  (2) 

LHOLE 

60 

END  IF 

LHOLE 

61 

RETURN 

LHOLE 

62 

END 

LHOLE 

fXN  5 u:5: 
SUBROUTINE  LHOLE 
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-VARIABLE  NAP--(LO=A) 

-NAME--- ADDRESS --BLOCK PROPERTIES TYPE 


AFLAC 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

C 

2 1 4B 

INTEGER 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/INITILN/ 

REAL 

FTOT 

67B 

/ INITILN/ 

INTEGER 

HERR 

IB 

/HOLEN/ 

INTEGER 

HOLE 

OB 

/HOLEC/ 

CHAR»3 

HTOT 

OB 

/HOLEN/ 

INTEGER 

PFN 

215B 

CHAR* 7 

QUALITY 

IB 

/INITILN/ 

INTEGER 

R 

2 1 3B 

INTEGER 

RFLAG 

3B 

/ INITILN/ 

REAL 

-SYMBOLIC  CONSTANTS--! LO=A> 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

HMAX  INTEGER  35 


-PROCEDURES--(LO=A) 
-NAME TYPE 

GETLEN  INTEGER 

PF 

WARNING 


ARCS CLASS 

1 FUNCTION 

5 SUBROUTINE 

1 SUBROUTINE 


-STATEMENT  LABELS--! LO=A) 

-LAB  EL -ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  53 

20  73B  54 

1000  130B  FORMAT  48 


-ENTRY  POINTS--!LO=A) 
-NAME ADDRESS- -ARCS- -- 

LHOLE  5B  0 


-I/O  UNITS--!LO=A) 
-NAME PROPERTIES- 

TAPE3  AUX/FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

2 2 2B 

= 148 

CM  LABELLED  COMMON  LENGTH 

145B 

= 1 01 

CM  STORAGE  USED 

UOOOB 

= 25088 

COMPILE  TIME 

0 .088 

SECONDS 

SIZE 

50 
1 40 
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1 

SUBROUTINE  ERROR(IERR) 

ERROR 

1 

2 

CHARACTER*  45 

MESSAGE!20) 

ERROR 

2 

3 

DATA 

MESSAGE ! 

1 ) / 'MATERIALS 

DATA 

BASE 

IS  EMPTY 

' / 

ERROR 

3 

4 

DATA 

MESSAGE! 

2 ) / ' FREQUENCY 

IS  OUT  OF  1 

RANGE 

' / 

ERROR 

4 

5 

DATA 

MESSAGE ! 

3) / 'THIS  MATERIAL 

IS  NOT 

IN  DATA  BASE 

' / 

ERROR 

5 

8 

DATA 

MESSAGE! 

4 )/ 'DENOMINATOR  IS 

ZERO 

' / 

ERROR 

8 

7 

DATA 

MESSAGE ! 

S ) / ' FILE  HANDLING 

ERROR 

' / 

ERROR 

7 

8 

DATA 

MESSAGE! 

8)  / ‘ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

8 

9 

DATA 

MESSAGE! 

7 ) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

9 

10 

DATA 

MESSAGE! 

8)  / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

10 

11 

DATA 

MESSAGE! 

9 ) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

1 1 

12 

DATA 

MESSAGE! 

10) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

12 

13 

DATA 

MESSAGE! 11)/ 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

13 

14 

DATA 

MESSAGE! 12) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

14 

15 

DATA 

MESSAGE! 13) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

15 

18 

DATA 

MESSAGE! 14) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

18 

17 

DATA 

MESSAGE! 15 ) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

17 

18 

DATA 

MESSAGE! 18) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

18 

19 

DATA 

MESSAGE! 17 ) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

1 9 

20 

DATA 

MESSAGE! 18) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

20 

21 

DATA 

MESSAGE! 19 ) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

21 

22 

DATA 

MESSAGE!20) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

22 

23 

IERRM=5 

ERROR 

23 

24 

IF(IERR.GT.IERRM)  IERR=20 

ERROR 

24 

25 

VRITE(8,10)  lERR, MESSAGE! lERR) 

ERROR 

25 

28  10 

FORMAT!'  ***ERROR  NUMBER 

_ 1 

, 15  , 

* * * * 

' ,A45) 

ERROR 

28 

27 

CALL 

PMDSTOP 

ERROR 

27 

28 

STOP 

' ERROR ' 

ERROR 

28 

29 

END 

ERROR 

29 

-VARIABLE  MAP--!LO=A) 

-NAME- --ADDRESS- -BLOCK PROPERTIES 

TYPE 

SIZE 

lERR 

1 DUMMY-ARG 

INTEGER 

lERRM 

210B 

INTEGER 

MESSAGE 

58B 

CHAR*45 

20 

--PROCEDURES--(LO=A> 

-NAME TYPE ARCS CLASS 

PMDSTOP  0 SUBROUTINE 


--STATEMENT  LABELS-- ( LO=A ) 

-LAB  EL- ADDRESS PROPERTIES DEF 

10  38B  FORMAT  28 


--ENTRY  POINTS--(LO=A) 
-NAME---ADDRESS--ARGS--- 

ERROR  5B  1 
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--I/O  UNITS--(LO=A) 

-NAME PROPERTIES 

TAPE8  FMT/SEQ 


--STATISTICS-- 

PROGRAM-UNIT  LENGTH  213B  = 139 

CM  STORAGE  USED  81000B  = 25088 

COMPILE  TIME  0.055  SECONDS 
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SUBROUTINE 

WARNING 

74/175  OPTxO 

1 

SUBROUTINE  WARNING(ERR) 

WARNING 

i 

2 

INTEGER  ERR,  ERRM 

WARNING 

3 

CHARACTER»45  MESSAGE(20) 

WARNING 

3 

4 

DATA 

MESSAGE!  l)/'"HOLE-  DATA  FILE  DOES  NOT  EXIST 

FOR  THIS 

BLDG ' / 

WARNING 

4 

5 

DATA 

MESSAGE!  2)/ 'FILE  HANDLING  PROBLEM  ON  "HOLE" 

DATA  FILE 

' / 

WARNING 

C 

6 

DATA 

MESSAGE!  3) /'"MATTER"  FILE  DOES  NOT  EXIST  FOR 

THIS  BLDG  ' / 

WARNING 

6 

7 

DATA 

MESSAGE!  4)/ 'FILE  HANDLING  PROBLEM  ON  "MATTER 

FILE 

' / 

WARNING 

7 

8 

DATA 

MESSAGE!  5)/ '"TYPE"  DATA  FILE  DOES  NOT  EXIST 

FOR  THIS 

BLDG ' / 

WARNING 

B 

9 

DATA 

MESSAGE!  6) /'FILE  HANDLING  PROBLEM  ON  "TYPE" 

FILE 

' / 

WARNING 

9 

1 0 

DATA 

MESSAGE!  7)/ '"WALL"  DATA  FILE  DOES  NOT  EXIST 

FOR  THIS 

BLDG ' / 

WARNING 

10 

1 1 

DATA 

MESSAGE!  8) /'FILE  HANDLING  PROBLEM  ON  "WALL" 

FILE 

' / 

WARNING 

1 1 

1 2 

DATA 

MESSAGE!  9)/ 'HEIGHT  AND  WIDTH  OF  ROOM  MISSING 

' / 

WARNING 

12 

13 

DATA 

MESSAGE ! 10 )/' LENGTH  OF  ROOM  IS  MISSING 

' / 

WARNING 

13 

1 4 

DATA 

MESSAGE! 11  )/' FREQ  FILE  DOES  NOT  EXIST  FOR  THIS  BLDG 

' / 

WARNING 

14 

15 

DATA 

MESSAGE! 12  )/' FILE  HANDLING  PROBLEM  WITH  FREQ 

FI  LE 

' / 

WARNING 

15 

1 6 

DATA 

MESSAGE! 13)/ 'WARNING  CODE  IS  OUT  OF  RANGE 

' / 

WARNING 

16 

17 

DATA 

MESSAGE! 14) / 'WARNING  CODE  IS  OUT  OF  RANGE 

' / 

WARNING 

17 

18 

DATA 

MESSAGE! 15 )/ 'WARNING  CODE  IS  OUT  OF  RANGE 

' / 

WARNING 

18 

19 

DATA 

MESSAGE ! 16 )/ 'WARNING  CODE  IS  OUT  OF  RANGE 

' / 

WARNING 

19 

20 

DATA 

MESSAGE! 17 )/ 'WARNING  CODE  IS  OUT  OF  RANGE 

' / 

WARNING 

20 

21 

DATA 

MESSAGE! 18) / 'WARNING  CODE  IS  OUT  OF  RANGE 

' / 

WARNING 

21 

22 

DATA 

MESSAGE! 19 )/ 'WARNING  CODE  IS  OUT  OF  RANGE 

' / 

WARNING 

22 

23 

DATA 

MESSAGE!20)/ 'WARNING  CODE  IS  OUT  OF  RANGE 

' / 

WARNING 

23 

24 

ERRM= 

12 

WARNING 

24 

25 

I ERR 

= ERR 

WARNING 

25 

26 

IF (ERR . GT . ERRM)  IERR=20 

WARNING 

26 

27 

WRITE(6, 20) 

WARNING 

27 

28 

WRITE(6,10)  ERR .MESSAGE! lERR) 

WARNING 

28 

29 

WRITE (6,20) 

WARNING 

29 

30 

10 

FORMAT!'  ***WARNING  NUMBER  = ',15,'  **»  ',A45) 

WARNING 

30 

31 

20 

FORMAT! • ') 

WARNING 

31 

32 

RETURN 

WARNING 

32 

33 

END 

WARNING 

33 

-VARIABLE  MAP--(LO=A) 

-NAME- --ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


ERR 

1 DUMMY -ARG 

ERRM 

60B 

lERR 

213B 

MESSAGE 

61B 

INTEGER 

INTEGER 

INTEGER 

CHAR*45  20 


-STATEMENT  LABELS-- ( LO=A) 

-LAB  EL -ADDRESS PROPERTIES DEF 


10  34B  FORMAT  30 

20  42B  FORMAT  31 


-ENTRY  POINTS--(LO=A> 
-NAME ADDRESS- -ARGS 
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--I/O  UNITS--(LO=A) 

-NAME PROPERTIES 


WARNING  5B 


TAPE6  FMT/SEQ 


--STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


216B  r 142 
61000B  X 2S08B 
0.057  SECONDS 
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Appendix  9.4  Listing  of  Computer  Program  SWALLS 


]32 


1 
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PROGRAM  SUALLS  74/175  OPT=0 

1 PROGRAM  SWALLS  ( INPUT, TAPE  1 =INPUT)  5VALLS 

2 • SVALL3 

3 "THIS  INTERACTIVE  PROGRAM  INPUTS  THE  DATA  DESCRIBING  EACH  VALL  SVALLS 

4 »IN  THE  BUILDING  AND  STORES  IT.  THE  FILE  NAME  IS  CREATED  BY  SUALLS 

5 ‘ATTACHING  "B"  TO  THE  FRONT  OF  AND  "W"  TO  THE  BACK  OF  THE  BUILDING  SUALLS 

6 ‘IDENTIFICATION.  THE  BUILDING  IDENTIFICATION  CAN  BE  NO  MORE  SUALLS 

7 ‘THAN  5 ALPHANUMERIC  CHARACTERS.  SUALLS 

8 SUALLS 

10  “‘  COMMON  FOR  INITIAL  PARAMETERS  “*COMF 

12  INTEGER  FMAX  COMF 

13  PARAMETER  (FMAX  = 50)  COMF 

14  COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX),  FERR,  COMF 

15  $ FTOT  COMF 

16  COMMON  /INITILC/  BLDG  COMF 

17  CHARACTER  * 5 BLDG  COMF 

18  REAL  FREQ,  AFLAG,  RFLAG,  FREQA  COMF 

19  INTEGER  QUALITY,  FERR,  FTOT  COMF 

23  “*  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  UALLS  *“COMR 

25  INTEGER  RMAX  COMR 

26  PARAMETER  (RMAX  = 20)  COMR 

27  COMMON  /ROOMN/  ROOMIRMAX  + 6,  RMAX  + 6),  NROOMS,  RAREA(RMAX)  COMR 

28  INTEGER  NROOMS  COMR 

29  REAL  ROOM  COMR 

31  t***ii*****tii***tii*************ii*t***t**it*****i(*ttt**t***iit*****t**ii*t**  ‘COMR 

32  *COMU 

33  *“  COMMON  FOR  DATABASE  OF  VALL  PARAMETERS  “*COMU 

35  INTEGER  UMAX  COMU 

36  PARAMETER  (UMAX  = 75)  COMU 

37  COMMON  /WALLN/  WD IMIVMAX , 3 ) , UTOT,  UERR  COMU 

38  COMMON  /WALLC/  VALL (UMAX, 4)  COMU 

39  INTEGER  VTOT,VERR  COMU 

40  REAL  VDIM  COMU 

41  CHARACTER  *3  VALL  COMU 

42  * =================================  COMU 

43  “ DESCRIPTION  OF  ARRAYS  COMU 

44  » =================================  COMV 

45  * WALL  IDENTIFICATION  COMV 

44  ‘ COMV 

47  * DIRECTION  FROM  TO  COMV 

48  * ROOM  ROOM  COMV 

49  * COMV 

50  ‘ VALL(X,1)  VALL(X,2)  UALL(X,3)  COMV 

51  * A3  A3  A3  COMV 

52  ‘ =========================================================  COMV 

53  * WALL  PARAMETERS  COMV 

54  ‘ COMV 

55  * MATERIAL  HEIGHT  VIDTH  LAYER  THICKNESS  COMV 

54  * COMU 

57  * VALL(X,4)  VDIM<X,1)  VDIM(X,2)  VDIM(X,3)  COMV 

58  * A3  FB.2  F8.2  F8.2  COMV 

59  COMV 

61  INTEGER  GETLEN , QU IT , ABORT , ANSWER , OLDF I LE , N, Y 1 , Y2 , L I NE  SVALLS 

62  INTEGER  lERR  SWALLS 

63  CHARACTER  * 7 PFN  SVALLS 

64  * SWALLS 
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PROGRAM  SUALLS  74/175  OPT=0 


65 

* INITIALIZATION 

SWALLS 

66 

QUIT  = 0 

SWALLS 

67 

WTOT  = 0 

SWALLS 

68 

ABORT  = 0 

SWALLS 

69 

100 

PRINT* 

SWALLS 

70 

PRINT  *,  'ENTER  BUILDING  IDENTIFICATION  (E.G.  ''lOl'')' 

SWALLS 

71 

PRINT  *,  ' (NO  MORE  THAN  5 ALPHANUMERIC  CHARACTERS)' 

SWALLS 

72 

REWIND  1 

SWALLS 

73 

READ(1,*,END=100)  BLDG 

SWALLS 

74 

SWALLS 

75 

IP  ( GETLEN(BLDG)  . GT . 5 ) THEN 

SWALLS 

76 

GO  TO  100 

SWALLS 

77 

END  IF 

SWALLS 

78 

PFN  = 'B'  11  BLDGCl :GETLEN(BLDG) ) II  'W 

SWALLS 

79 

t 

SWALLS 

80 

Dr 

LOAD  DATA  FROM  EXISTING  FILE  IF  NECESSARY 

SWALLS 

81 

200 

PRINT* 

SWALLS 

82 

PRINT*, 'WILL  THIS  BE' 

SWALLS 

83 

PRINT*,'  (1)  A MODIFICATION  OF  AN  EXISTING  FILE?' 

SWALLS 

84 

PRINT* , ' ( 2)  A NEW  FILE? ' 

SWALLS 

85 

PRINT*, 'ENTER  A NUMBER  !!!' 

SWALLS 

86 

REWIND  1 

SWALLS 

87 

READ(1,*,END=200)  OLDFILE 

SWALLS 

88 

IF  ( ( OLDFILE  .NE.  1 ) .AND.  ( OLDFILE  . NE . 2 ) ) THEN 

SWALLS 

89 

GOTO  200 

SWALLS 

90 

ELSE  IF  ( OLDFILE  . EQ . 1 ) THEN 

SWALLS 

91 

t 

SWALLS 

92 

ttt 

CHECK  FOR  EXISTENCE  OF  PERMANENT  FILE  OF  SAME  NAME 

SWALLS 

93 

I ERR  = 0 

SWALLS 

94 

CALL  PF  < 'GET' ,0,PFN(1 ;GETLEN(PFN) ) , 'RC , lERR) 

SWALLS 

95 

IF  ( lERR  .EQ.  2 ) THEN 

SWALLS 

96 

PRINT* 

SWALLS 

97 

PRINT  *,  'FILE  ',PFN,  ' NOT  FOUND' 

SWALLS 

98 

PRINT*,  ' PROGRAM  ABORTED! !! ' 

SWALLS 

99 

PRINT* 

SWALLS 

100 

PRINT*,  'FIND  CORRECT  BUILDING  IDENTIFIER  AND  RESTART  ', 

SWALLS 

101 

+ 'PROGRAM' 

SWALLS 

1 02 

PRINT* 

SWALLS 

103 

STOP 

SWALLS 

104 

* 

SWALLS 

105 

ELSE 

SWALLS 

1 06 

CALL  LUALL 

SWALLS 

107 

IF  (WERR  .NE.  0)  CALL  ERROR(5) 

SWALLS 

1 08 

END  IF 

SWALLS 

109 

ELSE  IF  ( OLDFILE  . EQ . 2 ) THEN 

SWALLS 

1 10 

* 

SWALLS 

111 

nnt 

CHECK  FOR  EXISTENCE  OF  PERMANENT  FILE  OF  SAME  NAME 

SWALLS 

1 12 

lERR  = 0 

SWALLS 

113 

CALL  PF  ( ' GET' , 0, PFN( 1 :GETLEN(PFN> ) , 'RC ' , lERR) 

SWALLS 

114 

IF  ( lERR  .EQ.  0 ) THEN 

SWALLS 

115 

PRINT* 

SWALLS 

116 

PRINT*,  'DATA  FILE  ALREADY  EXISTS  FOR  BUILDING  ',BLDG 

SWALLS 

117 

PRINT* 

SWALLS 

1 18 

PRINT*, 'IF  YOU  ENTER  DATA  AND  STORE  IT,  YOU  WILL  WRITE  ', 

SWALLS 

119 

+ 'OVER  THE  OLD  FILE . ' 

SWALLS 

1 20 

250 

PRINT* 

SWALLS 

12  1 

PRINT*, 'YOU  MAY  EITHER  (1)  ABORT  OR  (2)  CONTINUE.' 

SWALLS 

1 22 

PRINT* ,' INDICATE  YOUR  CHOICE  BY  ENTERING  A NUMBER.' 

SWALLS 

123 

REWIND  1 

SWALLS 

124 

READ( 1 , * ,END=250>  ANSWER 

SWALLS 

125 

PRINT* 

SWALLS 

1 26 

PRINT*, ' PROGRAM  HAS  BEEN  ABORTED,  PER  YOUR  REQUEST' 

SWALLS 

127 

PRINT* 

SWALLS 

1 28 

IF  ( ANSWER  .EQ.  1 ) THEN 

SWALLS 

U 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 
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STOP 

3WAL  L S 

80 

1 30 

ELSE  IF  ( ANSWER  , EQ . 2 ) THEN 

SWALLS 

81 

13  1 

9 0 9 0 

CONTINUE 

SWALLS 

82 

1 32 

ELSE 

SWALLS 

83 

133 

GOTO  250 

SWALLS 

84 

1 34 

END  IF 

SWALLS 

35 

135 

ELSE  IF  ( lERR  .EQ.  2 ) THEN 

SWALLS 

36 

1 3& 

t 

SWALLS 

87 

137 

ft 

NO  DATA  FILE  EXISTS  FOR  THIS  BUILDING  AND  DATA  ENTRY 

SWALLS 

88 

1 3B 

ft 

CAN  CONTINUE 

SWALLS 

89 

139 

ft 

SWALLS 

90 

1 40 

9 0 9 1 

CONTINUE 

SWALLS 

91 

14  1 

ELSE 

SWALLS 

92 

1 42 

ft 

SWALLS 

93 

143 

ft 

‘‘PERMANENT  FILE  ERROR 

SWALLS 

94 

1 44 

ft 

SWALLS 

95 

145 

PRINT‘ 

SWALLS 

96 

1 46 

PRINT‘ PROGRAM  ABORTED  !!!' 

SWALLS 

97 

147 

PRINT‘,‘  SOME  PERMANENT  FILE  ERROR  HAS  OCCURRED' 

SWALLS 

98 

1 48 

PRINT*,'  DOUBLE  CHECK  YOUR  BUILDING  IDENTIFICATION  ', 

SWALLS 

99 

149 

+ 'AND  TRY  AGAIN' 

SWALLS 

100 

150 

STOP 

SWALLS 

101 

15  1 

END  IF 

SWALLS 

102 

152 

PRINT* 

SWALLS 

1 03 

153 

PRINT*,  ' BEGIN  ENTERING  DATA' 

SWALLS 

104 

154 

ftft*ftftft*ft**fttft**ftftftft***ft*ft*ft***ft*ft*ftft*ft*ftftllt*ftftAft*ftftftftftftftftft*ftft** 

SWALLS 

1 05 

155 

ft 

CHECK  TO  SEE  IF  THERE  IS  ENOUGH  ARRAY  SPACE 

SWALLS 

106 

1 56 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft 

SWALLS 

1 07 

157 

300 

IFIVTOT.GE  WMAX)  THEN 

SWALLS 

108 

158 

WTOT  = WMAX 

SWALLS 

1 09 

159 

PRINT  *,  'DATA  ENTRY  ABORTED.' 

SWALLS 

1 10 

160 

PRINT  *,  'MAXIMUM  NUMBER  OF  DATA  LINES  IN  FILE  WOULD' 

SWALLS 

1 11 

16  1 

PRINT  *,  ' HAVE  BEEN  EXCEEDED.  NO  MORE  THAN  ',WMAX 

SWALLS 

1 12 

162 

PRINT  *,  ' DATA  LINES  ARE  ALLOWED.' 

SWALLS 

1 13 

163 

PRINT  *,  ' TO  INCREASE  THE  MAXIMUM  NUMBER  OF  ENTRIES  ALLOWED,' 

SWALLS 

114 

164 

PRINT  *,  ■ CHANGE  THE  PARAMETER  "WMAX"  IN  EACH  COMMON  OF' 

SWALLS 

1 15 

165 

PRINT  *,  ' EVERY  SUBROUTINE  (THERE  ARE  FOUR  PLACES).' 

SWALLS 

116 

166 

PRINT  *,  ' THEN  RECOMPILE  THE  PROGRAM.' 

SWALLS 

1 17 

167 

GOTO  45  0 

SWALLS 

118 

168 

END  IF 

SWALLS 

1 19 

169 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft 

SWALLS 

120 

1 70 

VTOT  = WTOT  + 1 

SWALLS 

121 

171 

IF  ( WTOT  .EQ.  1)  THEN 

SWALLS 

122 

1 72 

CALL  DATA IN( 1 , WTOT) 

SWALLS 

1 23 

173 

ELSE 

SWALLS 

124 

1 74 

CALL  DATAIN  (0,WTOT) 

SWALLS 

1 25 

175 

END  IF 

SWALLS 

126 

176 

400 

PRINT* 

SWALLS 

1 27 

177 

PRINT*,  'DO  YOU  WANT  TO  ENTER  MORE  DATA?', 

SWALLS 

128 

178 

+ ' ( 1 ) YES  (2)  NO' 

SWALLS 

1 29 

179 

PRINT*,  ' ENTER  A NUMBER  !!!' 

SWALLS 

1 30 

1 80 

REWIND  1 

SWALLS 

1 31 

18  1 

READ( 1, *,END=400)  ANSWER 

SWALLS 

132 

182 

IF  ( (ANSWER  .NE.  1)  .AND.  (ANSWER  .NE.  2)  ) THEN 

SWALLS 

1 33 

183 

GOTO  400 

SWALLS 

134 

184 

ELSE  IF  ( ANSWER  .EQ.  1)  THEN 

SWALLS 

1 35 

185 

GOTO  300 

SWALLS 

136 

186 

ELSE  IF  ( ANSWER  .EQ.  2 ) THEN 

SWALLS 

1 37 

187 

PRINT* 

SWALLS 

138 

188 

PRINT*,  'DATA  ENTRY  DISCONTINUED' 

SWALLS 

1 39 

189 

END  IF 

SWALLS 

140 

190 

END  IF 

SWALLS 

1 41 

19  1 

ft 

SWALLS 

1 42 

192 

ft  ft  ft 

MANIPULATE  DATA 

SWALLS 

1 43 

135 
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193 

450 

CALL  MANIP  (QUIT, ABORT) 

SWALLS 

144 

194 

* 

SWALLS 

1 45 

195 

tt  (t  * 

TERMINATE  PROGRAM,  STORING  DATA  IF  NECESSARY 

SWALLS 

146 

196 

IF  ( QUIT  .EQ.  1 ) THEN 

SWALLS 

1 47 

197 

OPEN(UNIT=6 , FILE=PFN( 1 ; GETLEN( PFN) ) , FORM= ' FORMATTED ' , 

SWALLS 

148 

198 

+ ACCESS='SEQUENTIAL' , STATUS* ' NEW ' > 

SWALLS 

1 49 

199 

500 

FORMAT  ( IX, 4(  IX , A3  ) , 3( IX, F8  . 2)  ) 

SWALLS 

150 

200 

DO  600  N = 1 ,WTOT 

SWALLS 

151 

20  1 

WRITE  ( 6 , 500  ) <WALL(N,Y1 ),  Y 1 =1  , 4 ) , ( WD IM( N, Y2 ) , Y2  = l,3) 

SWALLS 

152 

202 

600 

CONTINUE 

SWALLS 

1 53 

203 

ENDFILE(6) 

SWALLS 

154 

204 

WARNING* 

CALL  PF  ( 'REPLACE' ,0,PFN(1 :GETLEN(PFN) ) ) 

NUMBER  OF  ARGUMENTS  IN  REFERENCE  TO  _PF  IS  NOT  CONSISTENT 

SWALLS 

1 55 

205 

CLOSE(6,STATUS='DELETE' ) 

SWALLS 

1 56 

206 

PRINT* 

SWALLS 

157 

207 

PRINT*, 'DATA  HAS  BEEN  STORED  AND  PROGRAM  TERMINATED' 

SWALLS 

1 58 

208 

END  IF 

SWALLS 

159 

209 

IF(  ABORT  EQ.  1 ) THEN 

SWALLS 

1 68 

210 

PRINT* 

SWALLS 

161 

211 

PRINT*,  'PROGRAM  HAS  BEEN  ABORTED' 

SWALLS 

1 62 

212 

PRINT*,'  NO  DATA  HAS  BEEN  STORED  !!!' 

SWALLS 

163 

213 

END  IF 

SWALLS 

1 64 

214 

STOP 

SWALLS 

165 

2 15 

END 

SWALLS 

1 66 

--VARIABLE  MAP--(LO=A) 


NAME--- 

ADDRESS- 

-BLOCK 

-PROPERTIES 

TYPE 

---SIZE 

ABORT 

1216B 

INTEGER 

AFLAG 

2B 

1 INITILN/ 

REAL 

ANSWER 

1217B 

INTEGER 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTOT 

67B 

/ INITILN/ 

INTEGER 

I ERR 

1 224B 

INTEGER 

LINE 

NONE 

UNUSED/*S* 

INTEGER 

N 

122  IB 

INTEGER 

NROOMS 

1244B 

/ROOMN/ 

INTEGER 

OLDFILE 

1 220B 

INTEGER 

PFN 

1 225B 

CHAR*7 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

QUIT 

1215B 

INTEGER 

RAREA 

1 245B 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

WALL 

OB 

/WALLC/ 

CHAR*3 

300 

WDIM 

OB 

/WALLN/ 

REAL 

225 

WERR 

34ZB 

/WALLN/ 

INTEGER 

WTOT 

34  IB 

/WALLN/ 

INTEGER 

Y1 

1 222B 

INTEGER 

Y2 

1 22  3B 

INTEGER 

--SYMBOLIC  CONSTANTS--! LO=A) 


-NAME TYPE VALUE 

PMAX  INTEGER  50 
RMAX  INTEGER  20 
WMAX  INTEGER  75 


136 


FTN  J U552  83/12/24.  11.29.46  PAGE  5 

PROGRAM  SUALLS  74/175  OPT=0 


-PROCEDURES--(LO=A) 
-NAME TYPE - 

--ARGS 

CLASS 

-NAME 

---TYPE 

ARG3--- 

CLASS 

DATAIN 

2 

SUBROUTINE 

LWALL 

0 

SUBROUTINE 

ERROR 

1 

SUBROUTINE 

MAN  IP 

2 

SUBROUTINE 

CETLEN  INTEGER 

1 

FUNCTION 

PF 

5 

SUBROUTINE 

-STATEMENT  LABELS--! L0=A) 


-LABEL- 

ADDRESS-- 

PROPERTIES- 

---DEF 

100 

2 IB 

69 

200 

47B 

81 

250 

166B 

120 

300 

246B 

157 

400 

30  6B 

176 

-ENTRY 

POINTS--! 

LO  = A) 

-NAME-- 

-ADDRESS- 

-ARCS 

SWALLS 

14B 

0 

-I  10  UNITS--(L0=A) 
-NAME---  PROPERTIES- 

TAPEl  FMT/SEQ 
TAPE6  AUX/FMT/SEQ 


-LABEL 

-ADDRESS 

--PROPERTIES--- 

-DEF 

450 

344B 

1 93 

500 

714B 

FORMAT 

199 

600 

INACTIVE 

DO-TERM 

202 

9090 

»NO  REFS* 

131 

9091 

*NO  REFS* 

1 40 

-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

1231B 

= 665 

CM  LABELLED  COMMON  LENGTH 

205  7B 

= 1071 

CM  STORAGE  USED 

63000B 

= 2611 

COMPILE  TIME 

0.317 

SECONDS 

1 WARNING  ERROR  IN 

SWALLS 

137 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


SUBROUTINE  DATAIN  ( INSERT , L INE ) SWALLS 

***it****«****«ik***«**ikit***)t««i****A***lt***<i***«*****«***«***<Mt**********  *COMR 
***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  ***COMR 

**iit**«4ninli****«:***«***»*«*il[*«*«i«******«*«******«*«***lt««t******<t*lt*ilt«[*«***COMR 
INTEGER  RMAX  COMR 

PARAMETER  (RMAX  = 20)  COMR 

COMMON  /ROOMN/  ROOM(RMAX  + 6,  RMAX  + 6),  NHOOMS , RAREA(RMAX)  COMR 

INTEGER  NROOMS  COMR 

REAL  ROOM  COMR 

***ii***ii**ii*ii*ii*iiii*tt**t**t**t**iitt*ii*ii**ii*t**tiitttt*****tt***ttt***tit  * * COMR 
*iiiit****1i*1i**1i****1i*1i*t**t1it*t1l*1i**t***fkt****ttt*1i*t1tt*t*t1c**1t*1(****1t  * * COMR 

***  COMMON  FOR  DATABASE  OF  WALL  PARAMETERS  ***COMW 

INTEGER  WMAX  COMW 

PARAMETER  (WMAX  = 75)  COMW 

COMMON  /WALLN/  WD IM ( WMAX , 3 ) , WTOT , WERR  COMW 

COMMON  /WALLC/  WALL (WMAX, 4)  COMW 

INTEGER  WTOT, WERR  COMW 

REAL  WDIM  COMW 

CHARACTER  *3  WALL  COMW 

* =================================  COMW 

**  DESCRIPTION  OF  ARRAYS  COMW 

* =================================  COMW 

* WALL  IDENTIFICATION  COMW 

* - COMW 

* DIRECTION  FROM  TO  COMW 

* ROOM  ROOM  COMW 

* COMW 

* WALL(X,1)  WALL (X, 2)  WALL (X, 3)  COMW 

* A3  A3  A3  COMW 

* =========================================================  COMW 

* WALL  PARAMETERS  COMW 

* COMW 

* MATERIAL  HEIGHT  WIDTH  LAYER  THICKNESS  COMW 

* COMW 

* WALL(X,4)  WDIM(X,1)  WDIM(X,2)  WDIM(X,3)  COMW 

» A3  FB.2  F8.2  F8.2  COMW 

**lit**ii*tli*li*lit*litli*t*tl(tli**iiiili*liii*li*it**iit**ii***t*****1i*1iiilitini******lit  * * COMW 
<i)k*tir*4l*fi*lt*4i*ltA<i*tllt****4t***k***«Mtiiifttt****filtktt**<i)t*<ilt**A*)k***rlt******A*Alt*  Ik  COMW 

INTEGER  ANSWER, LOK,DOK,NOK,GETLEN,VAL,  INSERT, LINE ,V  SWALLS 

CHARACTER  *3  D IR , FROM , TO , MAT  SWALLS 

99  IF  ( INSERT  .EQ.  1 ) THEN  SWALLS 

ANSWER  = 1 SWALLS 

INSERT  = 1 SWALLS 

ELSE  SWALLS 

100  PRINT*  SWALLS 

PRINT*,  'IS  THIS  THE  FIRST  LAYER  OF  A WALL  (1)  YES  (2)  NO'  SWALLS 
PRINT*,  ■ ENTER  "0"  TO  ESCAPE  "DATA  ENTRY"  MODE'  SWALLS 

PRINT*,  ' ENTER  A NUMBER!!'  SWALLS 

REWIND  1 SWALLS 

READ( 1 , * ,END=100)  ANSWER  SWALLS 

END  IF  SWALLS 

* SWALLS 

IF  (ANSWER  .EQ.  0)  THEN  SWALLS 

WTOT  = WTOT  - 1 SWALLS 

PRINT*  SWALLS 

PRINT*,  'DATA  ENTRY  MODE  ABORTED'  SWALLS 

END  IF  SWALLS 

IF  ((ANSWER  NE.  2)  SWALLS 

+ .AND.  (ANSWER  .NE.  1)  SWALLS 

+ .AND.  (ANSWER  . NE . 0))  THEN  SWALLS 

PRINT*  SWALLS 

PRINT*,  ' INCORRECT  NUMBER! ! ' SWALLS 


167 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

1 3 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 
29 

170 

171 

172 
1 73 
174 
1 75 
176 
1 77 
178 
1 79 
180 
181 
182 
1 83 
184 
1 85 
186 
1 87 
188 
1 89 

190 

191 

192 
1 93 
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45 

PRINT*,  ' TRY  AGAIN!!  -OR-  ENTER  "0"  TO  ESCAPE 

DATA  ENTRY  MODE'SWALLS 

194 

44 

GOTO  99 

SWALLS 

i 9 5 

47 

END  IF 

SWALLS 

194 

46 

IF  (ANSWER  EQ.  1)  THEN 

SWALLS 

1 97 

49 

20  0 

PRINT* 

SWALLS 

198 

70 

PRINT*,  'ENTER  DIRECTION  (E.  G.  ’’LR'')' 

SWALLS 

1 99 

71 

REWIND  1 

SWALLS 

200 

72 

READ(1,*,END=200)  DIR 

SWALLS 

2 01 

73 

IF  ((DIR  .NE.  'LR') 

SWALLS 

202 

74 

+ 

.AND.  (DIR  .NE.  ' FB ' ) 

SWALLS 

2 03 

75 

+ 

AND . (DIR  .NE . ' UD ' ) ) THEN 

SWALLS 

204 

74 

PRINT*,  'DIRECTION  MUST  BE  ' ' LR  ' ' OR  ' ' FB  ' ' 

OR  ' ' 

UD' ' ' SWALLS 

2 05 

77 

PRINT* , 'TRY  AGAIN! ! ! ' 

SWALLS 

206 

78 

GOTO  200 

SWALLS 

2 07 

79 

END  IF 

SWALLS 

208 

SO 

WALL(LINE,1)  = DIR 

SWALLS 

209 

81 

t 

SWALLS 

2 1 0 

82 

300 

PRINT* 

SWALLS 

2 11 

83 

PRINT*,  'ENTER  "FROM"  (E.G.  ''02''  OR  ''Dl'')' 

SWALLS 

2 1 2 

84 

REWIND  1 

SWALLS 

2 13 

85 

READ( 1 , *, END=300)  FROM 

SWALLS 

2 1 4 

84 

LOK  = 0 

SWALLS 

2 15 

87 

DOK  = 0 

SWALLS 

214 

88 

NOK  = 0 

SWALLS 

2 17 

89 

IF  (GETLEN(FROM)  . EQ . 2)  THEN 

SWALLS 

2 1 8 

90 

LOK  = 1 

SWALLS 

2 19 

91 

END  IF 

SWALLS 

220 

92 

IF  ( FROM( 1:1)  . EQ.  'D' ) THEN 

SWALLS 

221 

93 

V = VAL(FROM(2 : 2)  ) 

SWALLS 

222 

94 

IF  ((V  .GE.  I)  .AND.  (V  .LE.  4>)  THEN 

SWALLS 

223 

95 

DOK  = 1 

SWALLS 

224 

94 

END  IF 

SWALLS 

2 25 

97 

END  IF 

SWALLS 

224 

98 

IF  ( ( ICHAR(FROM( 1 : 1 ) ) . GE . 14) 

SWALLS 

227 

99 

+ 

.AND.  ( ICHAR(FROM( 1 : 1 ) ) .LE.  25) 

SWALLS 

228 

1 00 

■f 

AND.  ( ICHAR (FROM(2 ; 2) ) . GE  . 14) 

SWALLS 

2 29 

10  1 

+ 

.AND.  ( ICHAR(FROM(2 : 2)  ) . LE . 25) 

SWALLS 

230 

1 02 

+ 

.AND.  (GETLEN(FROM)  . EQ . 2))  THEN 

SWALLS 

2 31 

103 

V = VAL(FROM) 

SWALLS 

232 

104 

IF  ((V  GE.  1)  AND.  (V  . LE . RMAX))  THEN 

SWALLS 

2 33 

105 

NOK  = 1 

SWALLS 

234 

104 

END  IF 

SWALLS 

2 35 

107 

END  IF 

SWALLS 

234 

108 

IF  ((LOK  .EQ.  1)  .AND.  ((DOK  . EQ . 1 ) OR.  (NOK 

. EQ. 

1)))  THEN  SWALLS 

237 

109 

WALL(LINE,2)  = FROM 

SWALLS 

238 

no 

ELSE 

SWALLS 

2 39 

11  1 

PRINT* 

SWALLS 

240 

1 12 

PRINT*,  'INCORRECT  ENTRY.  TRY  AGAIN!!' 

SWALLS 

241 

113 

GOTO  300 

SWALLS 

242 

114 

END  IF 

SWALLS 

2 43 

115 

* 

SWALLS 

244 

114 

400 

PRINT* 

SWALLS 

2 45 

117 

PRINT*,  'ENTER  "TO"  (E.G.  ''02''  OR  ''Dl'')' 

SWALLS 

244 

1 18 

REWIND  1 

SWALLS 

2 47 

119 

READ( 1 , * , END=400 ) TO 

SWALLS 

248 

1 20 

LOK  = 0 

SWALLS 

2 49 

12  1 

DOK  = 0 

SWALLS 

250 

122 

NOK  = 0 

SWALLS 

2 51 

123 

IF  (GETLEN(TO)  . EQ . 2)  THEN 

SWALLS 

252 

1 24 

LOK  = 1 

SWALLS 

253 

125 

END  IF 

SWALLS 

254 

124 

IF  (TO( 1 : 1 ) . EQ.  'D ' ) THEN 

SWALLS 

255 

127 

V = VAL(TO( 2 ; 2) ) 

SWALLS 

254 

128 

IF  ((V  .GE.  1)  AND.  (V  . LE . 4))  THEN 

SWALLS 

257 

139 
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129 

DOK  = 1 

SWALLS 

258 

1 30 

END  IF 

SWALLS 

259 

131 

END  IF 

SWALLS 

260 

132 

IF  ( ( ICHARITOd  ; 1 ) ) GE.  16) 

SWALLS 

261 

133 

+ 

.AND.  ( ICHAR(TO( 1 : 1) ) . LE . 

25) 

SWALLS 

262 

1 34 

+ 

.AND.  <ICHAR(TO(2:2))  .GE. 

16) 

SWALLS 

263 

135 

+ 

AND.  ( ICHAR(TO(2 : 2) ) . LE . 

25) 

SWALLS 

264 

136 

+ 

.AND.  (GETLEN(TO)  .EQ.  2)) 

THEN 

SWALLS 

265 

137 

V = VAL  (TO) 

SWALLS 

266 

1 38 

IF  <(V  .GE.  1)  .AND.  (V  LE. 

RMAX))  THEN 

SWALLS 

267 

139 

NOK  = 1 

SWALLS 

268 

140 

END  IF 

SWALLS 

269 

14  1 

END  IF 

SWALLS 

270 

1 42 

IF  ((LOK  .EQ.  1)  AND.  ((DOK  . 

EQ.  1)  .OR.  (NOK  .EQ.  1)))  THEN 

SWALLS 

271 

143 

WALL  (LINE, 3)  = TO 

SWALLS 

272 

144 

ELSE 

SWALLS 

273 

145 

PRINT* 

SWALLS 

274 

146 

PRINT*,  ‘INCORRECT  ENTRY.  TRY  AGAIN!!' 

SWALLS 

275 

147 

GOTO  400 

SWALLS 

276 

148 

END  IF 

SWALLS 

277 

149 

IF (FROM  .EQ.  TO)  THEN 

SWALLS 

278 

150 

PRINT* 

SWALLS 

279 

15  1 

PRINT*,  'INCORRECT  ENTRY!!' 

SWALLS 

280 

152 

PRINT*,  ‘"FROM"  CANNOT  EQUAL 

"TO"  ' 

SWALLS 

281 

153 

PRINT*,  'CHECK  YOUR  DATA  AND 

REENTER  "FROM"  AND  "TO"' 

SWALLS 

282 

154 

PRINT* 

SWALLS 

283 

155 

GOTO  300 

SWALLS 

284 

156 

END  IF 

SWALLS 

285 

157 

IF  ((FROM(l:l)  .EQ.  'D'  ) .AND 

. (TOd  : 1 ) . EQ.  'D'  ) ) THEN 

SWALLS 

286 

158 

PRINT* 

SWALLS 

287 

159 

PRINT*,  ' INCORRECT  ENTRY! ! ' 

SWALLS 

288 

160 

PRINT*,  ‘"FROM"  AND  "TO"  CANNOT  BOTH  CONTAIN  "D" ' 

SWALLS 

289 

16  1 

PRINT*,  ‘ CHECK  YOUR  DATA 

AND  REENTER  "FROM"  AND  "TO"' 

SWALLS 

290 

162 

PRINT* 

SWALLS 

291 

163 

GOTO  300 

SWALLS 

292 

164 

END  IF 

SWALLS 

293 

165 

* 

SWALLS 

294 

166 

440 

PRINT* 

SWALLS 

295 

167 

PRINT*,  'ENTER  HEIGHT,  METERS' 

SWALLS 

296 

168 

REWIND  1 

SWALLS 

297 

169 

READ(1,*,END=440)  WDIM(LINE,1) 

SWALLS 

298 

170 

* 

SWALLS 

299 

17  1 

460 

PRINT* 

SWALLS 

300 

172 

PRINT*,  'ENTER  WIDTH,  METERS' 

SWALLS 

301 

173 

REWIND  1 

SWALLS 

302 

174 

READ(1,*,END=460)  WDIM(LINE,2) 

SWALLS 

303 

175 

* 

SWALLS 

304 

176 

480 

PRINT* 

SWALLS 

305 

177 

PRINT*,  'ENTER  THICKNESS  OF  LAYER,  CENTIMETERS' 

SWALLS 

306 

178 

REWIND  1 

SWALLS 

307 

179 

READ( 1 , * , END=480 ) WDIM(LINE,3) 

SWALLS 

308 

180 

* 

SWALLS 

309 

18  1 

500 

PRINT* 

SWALLS 

310 

182 

PRINT*,  'ENTER  "MATERIAL  ID"  (E.G.  ''MOl'')' 

SWALLS 

311 

183 

REWIND  1 

SWALLS 

312 

184 

READd  ,*,END  = 500  ) MAT 

SWALLS 

3 13 

185 

IF  ( (GETLEN(MAT) . EQ.  3) 

SWALLS 

314 

186 

+ 

AND.  (MAT(1:1)  . EQ . 'M') 

SWALLS 

3 15 

187 

+ 

.AND.  (ICHAR(MAT(2:2) ) .GE. 

16) 

SWALLS 

316 

188 

+ 

.AND.  ( ICHAR(MAT(2 : 2 ) ) LE. 

25) 

SWALLS 

317 

189 

+ 

AND.  ( ICHAR(MAT(3 : 3) ) .GE. 

16  ) 

SWALLS 

318 

1 90 

+ 

.AND.  ( ICHAR(MAT(3 : 3 ) ) . LE . 

25))  THEN 

SWALLS 

319 

19  1 

WALL(LINE,4)  = NAT 

SWALLS 

320 

192 

ELSE 

SWALLS 

321 

140 
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193 

PRINT* 

SVALLS 

322 

194 

PRINT*,  'INCORRECT  ENTRY! 

I 

TRY  AGAIN' 

SWALLS 

3 23 

195 

GOTO  500 

SWALLS 

324 

196 

END  IF 

SWALLS 

3 25 

197 

END  IF 

SWALLS 

326 

1 98 

• 

SWALLS 

3 27 

199 

IF  (ANSWER  .EQ.2)  THEN 

SWALLS 

323 

200 

580 

PRINT* 

SWALLS 

329 

20  1 

PRINT*,  'ENTER  THICKNESS  OF 

LAYER,  CENTIMETERS' 

SWALLS 

330 

202 

REWIND  1 

SWALLS 

3 31 

203 

READ( 1 , * , END=580 ) WDIMCLINE 

,3) 

SWALLS 

332 

204 

t 

SWALLS 

3 33 

205 

600 

PRINT* 

SWALLS 

334 

206 

PRINT*,  'ENTER  "MATERIAL  ID 

II 

(E .G.  ' 'MOl ' ■ ) ■ 

SWALLS 

3 3; 

207 

REWIND  1 

SWALLS 

336 

208 

READ(1,*,END=600)  MAT 

SWALLS 

3 37 

209 

IF  ( (GETLEN(MAT)  .EQ.  3) 

SWALLS 

338 

2 10 

♦ 

AND.  (MAT(1;1)  .EQ.  'M' 

) 

SWALLS 

339 

211 

♦ 

.AND.  (ICHAR(MAT(2;2) ) . 

GE 

. 16) 

SWALLS 

340 

2 12 

AND.  ( ICHAR(MAT(2 ; 2) ) . 

LE 

. 25) 

SWALLS 

341 

213 

+ 

AND.  ( ICHAR(MAT( 3 : 3) ) . 

GE 

. 16) 

SWALLS 

342 

2 14 

♦ 

.AND.  ( ICHAR(MAT(3 ; 3) ) . 

LE 

. 25))  THEN 

SWALLS 

3 43 

215 

WALL (LINE, 4)  = MAT 

SWALLS 

344 

2 1 6 

ELSE 

SWALLS 

3 45 

217 

PRINT* 

SWALLS 

3 46 

2 18 

PRINT*,  'INCORRECT  ENTRY! 

! 

TRY  AGAIN' 

SWALLS 

S’?? 

219 

GOTO  600 

SWALLS 

343 

220 

END  IF 

SWALLS 

3 49 

22  1 

VALL(LINE,3)  = VALL(LINE-1, 

3) 

SWALLS 

350 

222 

VALL(LINE,2)  = WALL(LINE-1, 

2) 

SWALLS 

3 51 

223 

VALL(LINE,n  = VALL(LINE-1, 

1) 

SWALLS 

352 

224 

WDIM(LINE,1)  = VDIM(LINE-1, 

1 ) 

SWALLS 

353 

225 

VDIM(LINE,2)  = WDIM(LINE-1, 

2) 

SWALLS 

354 

226 

END  IF 

SWALLS 

355 

227 

RETURN 

SWALLS 

356 

228 

END 

SWALLS 

3 57 

VARIABLE 

MAP-- 

(LO=A) 

•NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE - 

---SIZE 

ANSWER 

1 43  4B 

INTEGER 

DIR 

1441B 

CHAR*3 

DOK 

1 43  6B 

INTEGER 

FROM 

1 44  2B 

CHAR*3 

INSERT 

1 

DUMMY-ARG 

INTEGER 

LINE 

2 

DUMMY-ARG 

INTEGER 

LOK 

143SB 

INTEGER 

MAT 

1 444B 

CHAR* 3 

NOK 

1 43  7B 

INTEGER 

NROOMS 

1 2 4 4B 

/ROOMN/ 

INTEGER 

RAREA 

1 245B 

/ROOMN/ 

REAL 

20 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

TO 

1 44  3B 

CHAR»3 

V 

1 440B 

INTEGER 

WALL 

06 

/WALLC/ 

CHAR»3 

300 

WDIM 

OB 

/WALLN/ 

REAL 

225 

WERR 

34  26 

/WALLN/ 

INTEGER 

WTOT 

34  IB 

/WALLN/ 

INTEGER 

141 
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-SYMBOLIC  CONSTANTS--(LO=A) 


-NAME TYPE VALUE 

RMAX  INTEGER  20 

WMAX  INTEGER  75 


-PROCEDURES--(LO=A) 

-NAME TYPE- ARGS CLASS 


CETLEN  INTEGER  1 FUNCTION 
ICHAR  INTEGER  1 INTRINSIC 
VAL  INTEGER  1 FUNCTION 


-STATEMENT  LABELS-- ( LO=A ) 


-LABEL- 

ADDRESS-- 

---PROPERTIES--- 

-DEF 

-LABEL 

-ADDRESS--- 

---PROPERTIES DEF 

99 

7B 

43 

460 

477B 

171 

100 

16B 

47 

480 

513B 

176 

200 

70B 

6 9 

500 

52  7B 

181 

300 

127B 

32 

580 

615B 

200 

400 

264B 

116 

600 

63  IB 

205 

440 

463B 

166 

-ENTRY 

POINTS--! 

LO  = A) 

-NAME-- 

-ADDRESS- 

-ARGS--- 

DATA  IN 

SB 

2 

-I/O  UNITS--(LO=A) 
-NAME---  PROPERTIES 

TAPEl  FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

1 4 4 7B 

= 807 

CM  LABELLED  COMMON  LENGTH 

1 76  6B 

= 10  14 

CM  STORAGE  USED 

63000B 

= 26112 

COMPILE  TIME 

0 4 36 

SECONDS 

142 
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1 

2 

3 

4 

5 

6 
7 
B 
9 

1 0 
11 
12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 


SUBROUTINE  MANIP  (QUIT, ABORT)  SUALLS 

tMtttittit»tii»ii*ttiii*iiiiii**tiitt**ii*ttit*t*t*tt*tli*****itt*tt********t*ii**tt*t  * COKU 
•••  COMMON  FOR  DATABASE  OF  WALL  PARAMETERS  **»COMV 

• •*«**t(ii*******«i«*«*ii****«****»t)k*****)t****»***«*****««****«t*****)i***  <m<COMU 


INTEGER  UMAX 
PARAMETER  (UMAX  = 75) 

COMMON  /WALLN/  WD IM ( WMAX , 3 ) , WTOT,  VERR 
COMMON  /WALLC/  WALL (WMAX, 4) 

INTEGER  WTOT.WERR 
REAL  WDIM 
CHARACTER  *3  WALL 

» DESCRIPTION  OF  ARRAYS 

WALL  IDENTIFICATION 


DIRECTION 

FROM 

ROOM 

TO 

ROOM 

WALL (X , 1 ) 
A3 

WALL(X,2) 

A3 

WALL(X,3) 

A3 

WALL 

PARAMETERS 

MATER  lAL 

HEIGHT 

WIDTH 

LAYER  THICKNESS 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 


WALL(X,4)  WDIM(X,1)  WDIM(X,2)  WDIM(X,3) 

A3  F8 . 2 F8  . 2 F8  . 2 

**«*tlt**ilM)*tlK***A***ilMt***)t***1i*4t*<i**f(lt**ltAlt*1t*ikIkt*ltA*A******lt*1kA*lt)k**lt*  COMW 

* * * * It  * * t t * * t h t * 1 1 1 * * t * t * * * t*  It  * * 1 1 1 1 1 * * t It  * * It  * * t * * 1 1 * * * t * h h h * 1 1 1 * 1 1 1 1 1 * t * My 

INTEGER  ABORT,ANSWER,DOK, FLAGl , LOK , N, NOK , OK , OK  1 , OK2 , QU IT , INSERT  SWALLS 
INTEGER  TEMP, V,X,Y, COMMAND  SWALLS 

CHARACTER  * 3 DIR,  FROM,  TO,  MAT  SWALLS 

SWALLS 


358 

1 

2 

3 

4 

5 


9 

10 
11 
12 
13 
1 4 

15 

16 

17 

18 
1? 
20 
21 
22 

23 

24 

25 

26 

27 

28 
29 

360 
3 61 

362 

363 


35 

10  FLAGl  = 0 

SWALLS 

: 44 

36 

PRINT* 

SWALLS 

365 

37 

PRINT*,  'CHOOSE' 

SWALLS 

366 

38 

PRINT*,  ' (1)  DISPLAY  LINE  OF  DATA 

(4) 

DISPL.AY  ALL  LINES' 

SWALLS 

367 

39 

PRINT*,  ' (2)  INSERT  LINE  INTO  FILE 

(5  ) 

APPEND  LINES  OF  DATA' 

SWALLS 

368 

40 

PRINT*,  ' (3)  DELETE  LINE 

( 6 ) 

STORE  DATA  AND  EXIT  ' , 

SWALLS 

369 

41 

+ 'PROGRAM' 

SWALLS 

370 

42 

PRINT*,  ' 

(7) 

EXIT  PROGRAM  WITHOUT  ' 

, SWALLS 

3 71 

43 

♦ ' STORING  DATA ' 

SWALLS 

372 

44 

PRINT*,  'ENTER  A NUMBER  !!!' 

SWALLS 

373 

45 

PRINT* 

SWALLS 

374 

46 

REWIND  1 

SWALLS 

3 75 

47 

READ(1,*,END=10)  COMMAND 

SWALLS 

376 

48 

t 

SWALLS 

3 77 

49 

t 

SWALLS 

378 

SO 

***  DISPLAY  LINE  *** 

SWALLS 

3 79 

51 

t 

SWALLS 

380 

52 

IF  ( COMMAND  . EQ . 1 ) THEN 

SWALLS 

381 

53 

t 

SWALLS 

382 

54 

***  INDICATE  EMPTY  DATA  FILE 

SWALLS 

383 

55 

IF  ( WTOT  ,EQ.  0 ) THEN 

SWALLS 

354 

56 

PRINT* 

SWALLS 

385 

57 

PRINT*,  'DATA  FILE  IS  EMPTY  !!!' 

SWALLS 

386 

58 

* 

SWALLS 

3 87 

59 

***  ENTER  NUMBER  OF  LINE  TO  BE  DISPLAYED 

SWALLS 

388 

60 

ELSE 

SWALLS 

3 89 

61 

100  PRINT* 

SWALLS 

390 

62 

PRINT*,  'SPECIFY  THE  NUMBER  OF  THE 

LINE  TO  BE  DISPLAYED' 

SWALLS 

391 

63 

64 


PRINT* , 
REWIND  1 


( ENTER  "0"  TO  ESCAPE  DISPLAY  MODE  ) 


SWALLS 

SWALLS 


392 

393 


143 
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65 

READ(1,*,END=100)  N 

SWALLS 

394 

66 

SWALLS 

3 95 

67 

tt  * 

CHECK  VALIDITY  OF  LINE  NUMBER 

SWALLS 

396 

68 

IP  ( (N  GT.  WTOT)  .OR.  (N  .LT.  0)  ) THEN 

SWALLS 

3 97 

69 

PRINT* 

SWALLS 

398 

70 

PRINT*,  ‘ INCORRECT  NUMBER  !!!!!!  TRY  AGAIN  !!!' 

SWALLS 

3 99 

71 

PRINT*,  ' -OR-  ENTER  "0"  TO  ESCAPE  FROM 

SWALLS 

400 

72 

+ ‘ "DISPLAY"  MODE ' 

SWALLS 

401 

73 

GOTO  100 

SWALLS 

402 

74 

* 

SWALLS 

4 03 

75 

* 

ABORT  ‘DISPLAY’  MODE 

SWALLS 

404 

76 

ELSE  IF  ( N EQ.  0 ) THEN 

SWALLS 

4 05 

77 

PRINT* 

SWALLS 

406 

78 

PRINT*,  ' "DISPLAY"  MODE  ABORTED  !!!' 

SWALLS 

4 07 

79 

t 

SWALLS 

408 

80 

K tt 

DISPLAY  LINE  OF  DATA 

SWALLS 

4 0? 

81 

ELSE  IF  ( (N  GT.  0)  AND.  (N  LE.  WTOT)  ) THEN 

SWALLS 

410 

82 

PRINT* 

SWALLS 

4 11 

83 

CALL  DISPLAY!  N,  COMMAND) 

SWALLS 

412 

84 

A 

SWALLS 

4 13 

85 

END  IF 

SWALLS 

414 

86 

END  IF 

SWALLS 

4 15 

87 

END  IF 

SWALLS 

416 

88 

* 

SWALLS 

4 17 

89 

* 

SWALLS 

418 

90 

* A fc 

INSERT  LINE  *** 

SWALLS 

4 19 

91 

t 

SWALLS 

420 

92 

IF  ( COMMAND  . EQ . 2 ) THEN 

SWALLS 

421 

93 

SWALLS 

422 

94 

CHECK  TO  SEE  IF  THERE  IS  ENOUGH  ARRAY  SPACE 

SWALLS 

423 

95 

SWALLS 

424 

96 

IF(VTOT. GE .VMAX)  THEN 

SWALLS 

4 25 

97 

WTOT  = WMAX 

SWALLS 

426 

98 

PRINT  *,  'DATA  ENTRY  ABORTED.' 

SWALLS 

4 27 

99 

PRINT  *,  'MAXIMUM  NUMBER  OF  DATA  LINES  IN  FILE  WOULD' 

SWALLS 

428 

100 

PRINT  *,  ' HAVE  BEEN  EXCEEDED  NO  MORE  THAN  ',WMAX 

SWALLS 

4 29 

10  1 

PRINT  *,  ' DATA  LINES  ARE  ALLOWED.' 

SWALLS 

430 

102 

PRINT  *,  ' TO  INCREASE  THE  MAXIMUM  NUMBER  OF  ENTRIES  ALLOWED,' 

SWALLS 

4 31 

103 

PRINT  *,  ' CHANGE  THE  PARAMETER  "WMAX"  IN  EACH  COMMON  OF' 

SWALLS 

432 

104 

PRINT  *,  ' EVERY  SUBROUTINE  (THERE  ARE  FOUR  PLACES).' 

SWALLS 

433 

105 

PRINT  *,  ' THEN  RECOMPILE  THE  PROGRAM.' 

SWALLS 

434 

106 

GOTO  10 

SWALLS 

4 35 

107 

END  IF 

SWALLS 

436 

108 

AA*****A***AAAA**tAAAA***AA*tAAAAA*tA*AtA*t***A*AAftAfttAA**AAA* 

SWALLS 

4 37 

109 

* 

SWALLS 

438 

110 

* ** 

INDICATE  EMPTY  DATA  FILE 

SWALLS 

439 

11  1 

IF  ( WTOT  .EQ.  0 ) THEN 

SWALLS 

440 

1 12 

PRINT* 

SWALLS 

441 

113 

PRINT*,  'DATA  FILE  IS  EMPTY  !!!' 

SWALLS 

442 

1 14 

t 

SWALLS 

4 43 

115 

AAA 

REQUEST  NUMBER  OF  LINE  BEFORE  WHICH  INSERTION  IS  TO  BE  MADE 

SWALLS 

444 

1 16 

ELSE 

SWALLS 

4 45 

117 

200 

PRINT* 

SWALLS 

446 

118 

PRINT*,  'SPECIFY  NUMBER  OF  LINE  BEFORE  WHICH  A NEW  LINE  IS  ' 

, SWALLS 

4 47 

119 

+ 'TO  BE  INSERTED' 

SWALLS 

448 

1 20 

PRINT*,  ' ( ENTER  "0"  TO  ESCAPE  "INSERTION"  MODE  )' 

SWALLS 

4 49 

12  1 

REWIND  1 

SWALLS 

450 

1 22 

READ(1,*,END=200)  N 

SWALLS 

451 

123 

A 

SWALLS 

452 

1 24 

AAA 

CHECK  FOR  VALID  LINE  NUMBER 

SWALLS 

453 

125 

IF  ( ( N .LT.  0 ) .OR.  ( N . GT . WTOT  ) ) THEN 

SWALLS 

454 

126 

PRINT* 

SWALLS 

455 

127 

PRINT*,  ' INCORRECT  NUMBER  !!!' 

SWALLS 

456 

128 

PRINT*,  ' TRY  AGAIN  !!!  -OR-  ENTER  "0"  TO  ESCAPE', 

SWALLS 

457 

144 
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+ 

'"INSERTION"  MODE' 

SWALLS 

458 

1 30 

GOTO  200 

SWALLS 

4 5? 

13  1 

t 

SWALLS 

460 

1 32 

« t « 

ABORT 

INSERTION  MODE 

SWALLS 

461 

133 

ELSE  IF  ( N ,EQ.  0 ) THEN 

SWALLS 

462 

1 34 

PRINT* 

SWALLS 

4 63 

135 

PRINT*,  ' “INSERTION"  MODE  ABORTED' 

SWALLS 

464 

1 3& 

t 

SWALLS 

4 65 

137 

At* 

MAKE 

ROOM  FOR  NEW  LINE  OF  DATA 

SWALLS 

466 

1 3S 

ELSE  IF  ( (N  .GT.  0)  .AND.  (N  .LE.  WTOT)  ) THEN 

SWALLS 

467 

139 

DO  230  X = WTOT, N, -1 

SWALLS 

468 

1 40 

DO  210  Y = 1,4 

SWALLS 

4 69 

14  1 

WALL(X+1,Y)  = WALL(X,Y) 

SWALLS 

470 

142 

2 10 

CONTINUE 

SWALLS 

4 71 

143 

DO  220  Y = 1,3 

SWALLS 

472 

144 

WDIM(X+1 , Y)  = WDIMCX ,Y) 

SWALLS 

4 73 

145 

220 

CONTINUE 

SWALLS 

474 

146 

230 

CONTINUE 

SWALLS 

475 

147 

A 

SWALLS 

476 

1 48 

AAA 

ENTER 

DATA  FOR  NEW  LINE 

SWALLS 

4 77 

149 

WTOT  = WTOT  + 1 

SWALLS 

47  8 

ISO 

CALL  DATAIN  (1,N) 

SWALLS 

4 79 

15  1 

A 

SWALLS 

480 

152 

AAA 

INITIALIZE  FLAGS 

SWALLS 

4 81 

153 

OKI  = 0 

SWALLS 

482 

154 

OK2  = 0 

SWALLS 

483 

155 

OK  = 0 

SWALLS 

434 

1 56 

A 

SWALLS 

4 85 

157 

AAA 

TEST 

VALIDITY  OF  DATA 

SWALLS 

486 

1 58 

A 

SWALLS 

487 

159 

**»TEST  IF  NEW  LAYER  BELONGS  TO  THE  NEXT  WALL 

SWALLS 

488 

160 

IF  ( ( WALLIN, 1)  ,EQ.  WALL(N+1,1)  ) 

SWALLS 

489 

16  1 

+ 

AND.  ( WALLIN, 2)  . EQ . WALLIN+1,2)  ) 

SWALLS 

490 

1 62 

+ 

.AND.  I WALLIN, 3)  EQ.  WALLIN+1,3)  ) ) THEN 

SWALLS 

4 91 

163 

IF  I I WDIMIN,!)  EQ.  WDIMIN+1,1)  > 

SWALLS 

492 

164 

+ 

AND.  I WDIMIN, 2)  .EQ.  WDIMIN+1,2)  ) ) THEN 

SWALLS 

493 

165 

OKI  = 1 

SWALLS 

494 

166 

END  IF 

SWALLS 

4 95 

167 

END  IF 

SWALLS 

496 

1 68 

A 

SWALLS 

4 97 

169 

AAA 

TEST 

IF  NEW  LAYER  BELONGS  TO  PREVIOUS  WALL 

SWALLS 

4 98 

1 70 

IF  I N .GT,  1 ) THEN 

SWALLS 

4 99 

17  1 

IF  I I WALLIN,!)  .EQ.  WALLIN-1,1)  ) 

SWALLS 

500 

1 72 

+ 

AND.  I WALLIN, 2)  .EQ.  WALLIN-1,2)  ) 

SWALLS 

5 01 

173 

+ 

.AND.  I WALLIN, 3)  . EQ , WALLIN-1,3)  ) ) THEN 

SWALLS 

502 

174 

IF  I I WDIMIN,!)  .EQ.  WDIMIN-1,1)  ) 

SWALLS 

503 

175 

+ 

AND.  I WDIMIN, 2)  .EQ.  WDIMIN-1,2)  ) ) THEN 

SWALLS 

504 

1 76 

OK2  = 1 

SWALLS 

505 

177 

END  IF 

SWALLS 

506 

178 

END  IF 

SWALLS 

507 

179 

END  IF 

SWALLS 

508 

1 80 

A 

SWALLS 

509 

18  1 

IF  I I OKI  .EQ.  1 ) .OR.  I OK2  . EQ . 1 ) ) THEN 

SWALLS 

510 

182 

OK  = 1 

SWALLS 

5 1 1 

183 

END  IF 

SWALLS 

5 1 2 

1 84 

A 

SWALLS 

5 13 

185 

IF  I OK  .EQ.  1 ) THEN 

SWALLS 

5 1 4 

186 

PRINT* 

SWALLS 

5 15 

187 

PRINT*,  'THE  FOLLOWING  LINE  HAS  BEEN  ADDED  AS  LINE  ' 

, N SWALLS 

5 1 6 

188 

CALL  DISPLAY!  N,  COMMAND) 

SWALLS 

5 17 

189 

A 

SWALLS 

518 

190 

AAA 

REJECT  DATA  IF  DATA  DOESN'T  MATCH  PREVIOUS  OR  NEXT  LAYER 

SWALLS 

5 19 

19  1 

ELSE  IF  I OK  .EQ.  0 ) THEN 

SWALLS 

520 

1 92 

PRINT* 

SWALLS 

5 21 

145 
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1 93 

PRINT*,  'YOUR  DATA  WAS  NOT  ACCEPTED  !!!' 

SWALLS 

522 

194 

PRINT*,  ■ YOUR  DATA  MUST  REPRESENT  A LAYER 

1 

SWALLS 

5 23 

195 

+ 

' IN  AN  EXISTING  WALL' 

SWALLS 

524 

196 

PRINT*,  ' I.E.  THE  DIRECTION,  FROM,  TO,  HE 

ICHT,  AND  ' , 

SWALLS 

5 25 

197 

+ 

'WIDTH' 

SWALLS 

526 

1 98 

PRINT*,  ' PARAMETERS  MUST  MATCH  THE  WALL  JUST  ', 

SWALLS 

5 27 

199 

+ 

'BEFORE' 

SWALLS 

528 

200 

PRINT*,  ' OR  JUST  AFTER  YOUR  SPECIFIED  INSERTION  ' 

, SWALLS 

529 

20  1 

+ 

'POINT' 

SWALLS 

530 

202 

PRINT* 

SWALLS 

5 31 

203 

PRINT*,  'THE  FOLLOWING  DISPLAYS' 

SWALLS 

532 

204 

IF  ( N GT.  1 ) PRINT*, 'THE  LINE  BEFORE  YOUR 

LINE, ' 

SWALLS 

5 33 

205 

PRINT*,  'YOUR  LINE,  AND  THE  LINE  AFTER' 

SWALLS 

534 

206 

PRINT* 

SWALLS 

5 35 

207 

* 

SWALLS 

536 

208 

A A * 

DISPLAY  LINES  OF  DATA 

SWALLS 

5 37 

209 

IF  ( N GT.  1 ) CALL  DISPLAY  ( N- 1 , COMMAND 

) 

SWALLS 

538 

2 10 

CALL  DISPLAY(  N,  COMMAND) 

SWALLS 

5 39 

21  1 

CALL  DISPLAY  ( N+ 1 , COMMAND) 

SWALLS 

540 

2 12 

A 

SWALLS 

5 41 

213 

AAA 

REMOVE 

THE  LINE  OF  INCORRECTLY  ENTERED  DATA 

SWALLS 

542 

214 

DO  270  X = N,WTOT 

SWALLS 

5 43 

215 

DO  250  Y = 1 , 4 

SWALLS 

544 

2 16 

WALL (X , Y)  = WALL (X+1 , Y) 

SWALLS 

5 45 

217 

250 

CONTINUE 

SWALLS 

546 

2 18 

DO  260  Y = 1 , 3 

SWALLS 

5 47 

219 

WDIM(X,Y)  = WDIM(X+1,Y) 

SWALLS 

548 

220 

260 

CONTINUE 

SWALLS 

5 49 

22  1 

270 

CONTINUE 

SWALLS 

550 

222 

WTOT  = WTOT  - 1 

SWALLS 

551 

223 

END  IF 

SWALLS 

552 

224 

END 

IF 

SWALLS 

553 

225 

END 

IF 

SWALLS 

554 

226 

END 

IF 

SWALLS 

5 55 

227 

A 

SWALLS 

556 

228 

A 

SWALLS 

557 

229 

AAA 

DELETE 

LINE  *** 

SWALLS 

558 

230 

A 

SWALLS 

55? 

23  1 

IF  ( 

COMMAND  EQ.  3 ) THEN 

SWALLS 

560 

232 

A 

SWALLS 

561 

233 

AAA 

INDICATE  EMPTY  DATA  FILE 

SWALLS 

562 

234 

IF 

( WTOT  .EQ.  0 ) THEN 

SWALLS 

563 

235 

PRINT* 

SWALLS 

564 

236 

PRINT*,  'DATA  FILE  IS  EMPTY  !!!' 

SWALLS 

5 65 

237 

A 

SWALLS 

566 

238 

A AA 

READ  NUMBER  OF  LINE  TO  BE  DELETED 

SWALLS 

5 67 

239 

ELSE 

SWALLS 

568 

240 

300 

PRINT* 

SWALLS 

5 69 

24  1 

PRINT*,  'SPECIFY  THE  NUMBER  OF  THE  LINE  TO  BE  DELETED' 

SWALLS 

570 

242 

PRINT*,  ' (ENTER  "0"  TO  ESCAPE  DELETION  MODE)' 

SWALLS 

571 

243 

REWIND  1 

SWALLS 

572 

2 44 

READ( 1 , * ,END=300)  N 

SWALLS 

5 73 

24  5 

A 

SWALLS 

574 

246 

AAA 

CHECK 

VALIDITY  OF  LINE  NUMBER 

SWALLS 

575 

247 

IF  ( (N  ,GT.  WTOT  ) .OR.  ( N . LT . 0 ) ) THEN 

SWALLS 

576 

248 

PRINT* 

SWALLS 

5 77 

249 

PRINT*,  ' INCORRECT  NUMBER  !!!' 

SWALLS 

578 

250 

PRINT*,  ' TRY  AGAIN  !!!  -OR-  ENTER  "0"  TO 

ESCAPE  FROM' 

, SWALLS 

5 79 

25  1 

+ 

'"DELETE"  MODE' 

SWALLS 

580 

252 

GOTO  300 

SWALLS 

581 

253 

A 

SWALLS 

582 

254 

AAA 

ABORT 

'DELETE'  MODE 

SWALLS 

583 

255 

ELSE  IF  ( N .EQ.  0 ) THEN 

SWALLS 

584 

256 

PRINT*,  ' "DELETE"  MODE  ABORTED' 

SWALLS 

585 
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257 

t 

SWALL3 

5 8 6 

258 

ft  « t 

DOUBLE  CHECK  CHOICE  OP  LINE  TO  BE  DELETED 

SWALLS 

5 87 

25  9 

ELSE  IF  ((  N .GT.  0 ) AND.  ( N . LE . 

WTOT 

))  THEN 

SWALLS 

588 

260 

PRINT* 

SWALLS 

5 89 

26  1 

PRINT* , 'DOUBLE  CHECK  ! ! ! ' 

SWALLS 

590 

262 

PRINT*,  ■ DO  YOU  WANT  TO  DELETE 

THE 

FOLLOWING  LINE? : ' 

SWALLS 

5 91 

263 

CALL  DISPLAY!  N,  COMMAND) 

SWALLS 

592 

2 64 

305 

PRINT*,  ' ENTER  (1)  YES  OR  (2) 

NO' 

SWALLS 

5 93 

265 

REWIND  1 

SWALLS 

594 

266 

READ! 1 , * ,END=305)  ANSWER 

SWALLS 

5 95 

267 

ft 

SWALLS 

596 

268 

ft  ft  ft 

DELETE  LINE 

SWALLS 

5 97 

269 

IF  ! ANSWER  . EQ . 1 ) THEN 

SWALLS 

598 

270 

DO  330  X = N,  WTOT  - 1 

SWALLS 

5 9? 

27  1 

DO  310  Y = 1,4 

SWALLS 

600 

272 

WALL  !X , Y)  = WALL!X  + 1 , Y) 

SWALLS 

6 01 

273 

3 10 

CONTINUE 

SWALLS 

602 

2 74 

DO  320  Y = 1,3 

SWALLS 

603 

275 

WDIM!X, Y)  = WDIM! X+1 ,Y) 

SWALLS 

604 

276 

320 

CONTINUE 

SWALLS 

605 

27  7 

330 

CONTINUE 

SWALLS 

606 

278 

WTOT  = WTOT  - 1 

SWALLS 

607 

27  9 

PRINT* 

SWALLS 

608 

280 

PRINT*,  'LINE  # ',N,'  DELETED' 

SWALLS 

6 09 

28  1 

END  IF 

SWALLS 

6 1 0 

282 

ft 

SWALLS 

6 11 

283 

END  IF 

SWALLS 

612 

284 

END  IF 

SWALLS 

6 13 

285 

END  IF 

SWALLS 

6 1 4 

286 

ft 

SWALLS 

6 15 

287 

ft 

- SWALLS 

616 

288 

ft  ft  ft 

DISPLAY  ALL  DATA  *** 

SWALLS 

6 17 

289 

ft 

- SWALLS 

6 1 8 

290 

IF  ! COMMAND  . EQ . 4 ) THEN 

SWALLS 

6 19 

29  1 

ft 

SWALLS 

620 

292 

ft  ft  ft 

INDICATE  EMPTY  DATA  FILE 

SWALLS 

6 21 

293 

IF  ! WTOT  .EQ.  0 ) THEN 

SWALLS 

622 

294 

PRINT* 

SWALLS 

6 23 

295 

PRINT*,  'DATA  FILE  IS  EMPTY  !!!' 

SWALLS 

624 

296 

ft 

SWALLS 

6 25 

297 

ft  ft  ft 

DISPLAY  DATA 

SWALLS 

626 

298 

ELSE 

SWALLS 

6 27 

299 

PRINT* 

SWALLS 

628 

300 

CALL  DISPLAY!  N,  COMMAND) 

SWALLS 

6 29 

30  1 

ft 

SWALLS 

630 

302 

END  IF 

SWALLS 

6 31 

303 

END  IF 

SWALLS 

632 

304 

ft 

SWALLS 

6 33 

305 

ft 

- SWALLS 

634 

306 

ft  ft  ft 

ADD  DATA  *** 

SWALLS 

6 35 

307 

ft 

- SWALLS 

636 

308 

IF  ! COMMAND  . EQ . 5 ) THEN 

SWALLS 

6 37 

309 

ft 

SWALLS 

638 

3 10 

ft  ft  ft 

ENTER  DATA 

SWALLS 

6 39 

31  1 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft 

SWALLS 

6 40 

3 12 

ft 

CHECK  TO  SEE  IF  THERE  IS  ENOUGH  ARRAY  SPACE 

SWALLS 

6 41 

31  3 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft 

SWALLS 

642 

314 

500 

IF!WTOT. GE ,WMAX)  THEN 

SWALLS 

6 43 

31  5 

WTOT  = WMAX 

SWALLS 

644 

316 

PRINT  *,  'DATA  ENTRY  ABORTED.' 

SWALLS 

6 45 

31  7 

PRINT  *,  'MAXIMUM  NUMBER  OF  DATA  LINES  IN 

FILE 

WOULD' 

SWALLS 

646 

3 18 

PRINT  *,  ' HAVE  BEEN  EXCEEDED.  NO  MORE  THAN  ' ,WMAX 

SWALLS 

6 47 

31  9 

PRINT  *,  ' DATA  LINES  ARE  ALLOWED.' 

SWALLS 

648 

320 

PRINT  *,  ' TO  INCREASE  THE  MAXIMUM  NUMBER 

OF  ENTRIES  ALLOWED, ' 

SWALLS 

6 49 
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321 

PRINT  *,  ' CHANGE  THE  PARAMETER  "VmAX"  IN  EACH  COMMON  OF' 

SWALLS 

650 

322 

PRINT  *,  ' EVERY  SUBROUTINE  (THERE  ARE  FOUR  PLACES).  ' 

SWALLS 

6 51 

323 

PRINT  *,  ' THEN  RECOMPILE  THE  PROGRAM.' 

SWALLS 

652 

324 

GOTO  10 

SWALLS 

6 53 

325 

END  IF 

SWALLS 

654 

326 

SWALLS 

655 

327 

WTOT  = WTOT  + 1 

SWALLS 

656 

328 

CALL  DATAIN  (0,WTOT) 

SWALLS 

657 

32  9 

510  PRINT* 

SWALLS 

658 

3 30 

PRINT*,  'DO  YOU  WANT  TO  ENTER  MORE  DATA?  (1)  YES  ( 2 ) NO ' 

SWALLS 

6 5 9 

33  1 

PRINT*,  ' ENTER  A NUMBER  !!!' 

SWALLS 

660 

332 

REWIND  1 

SWALLS 

6 61 

333 

READ( 1 , *,END=5 10)  ANSWER 

SWALLS 

662 

334 

t 

SWALLS 

6 63 

335 

***  CHECK  VALIDITY  OF  NUMBER 

SWALLS 

664 

336 

IF  ( ( ANSWER  NE.  1 ) .AND.  ( ANSWER  NE.  2 ) ) THEN 

SWALLS 

6 65 

337 

GOTO  510 

SWALLS 

666 

338 

* 

SWALLS 

6 67 

339 

***  ENTER  MORE  DATA 

SWALLS 

668 

3 40 

ELSE  IF  ( ANSWER  .EQ.  1 ) THEN 

SWALLS 

6 69 

34  1 

GOTO  500 

SWALLS 

670 

342 

* 

SWALLS 

6 71 

343 

»**  DISCONTINUE  DATA  ENTRY 

SWALLS 

672 

344 

ELSE  IF  ( ANSWER  .EQ.  2 ) THEN 

SWALLS 

6 73 

345 

PRINT* 

SWALLS 

674 

346 

PRINT*,  'DATA  ENTRY  DISCONTINUED' 

SWALLS 

6 75 

34  7 

He 

SWALLS 

676 

348 

END  IF 

SWALLS 

6 77 

349 

END  IF 

SWALLS 

678 

350 

« 

SWALLS 

6 79 

35  1 

* 

SWALLS 

680 

352 

***  STORE  DATA  AND  PROGRAM  *** 

SWALLS 

681 

35  3 

SWALLS 

682 

354 

IF  < COMMAND  . EQ . 6 ) THEN 

SWALLS 

683 

35  5 

600  PRINT* 

SWALLS 

684 

356 

PRINT* , 'DOUBLE  CHECK  ! ! ! ' 

SWALLS 

685 

357 

PRINT*,  ' DO  YOU  YOU  WANT  TO  STORE  THIS  DATA  AND  END  PROG' 

SWALLS 

686 

358 

PRINT*,  ' NOTE;  STORING  THIS  DATA  WILL  WIPE  OUT  ANY  OLD  FILE 

SWALLS 

6 87 

35  9 

PRINT*,  ' OF  THE  SAME  NAME  !!!' 

SWALLS 

688 

360 

PRINT*,  ' ENTER  A NUMBER:  (1)  YES  (2)  NO' 

SWALLS 

6 89 

36  1 

REWIND  1 

SWALLS 

690 

362 

READCl ,*,END=600)  ANSWER 

SWALLS 

6 91 

36  3 

* 

SWALLS 

692 

364 

***  SET  FLAG  FOR  STORING  DATA  IN  THE  MAIN  PROGRAM 

SWALLS 

6 93 

365 

IF  ( ANSWER  .EQ.  1 ) THEN 

SWALLS 

694 

366 

QUIT  = 1 

SWALLS 

6 95 

36  7 

RETURN 

SWALLS 

696 

368 

« 

SWALLS 

697 

369 

***  ABORT  'STORING'  MODE 

SWALLS 

698 

370 

ELSE  IF  ( ANSWER  EQ.  2 ) THEN 

SWALLS 

699 

37  1 

PRINT* 

SWALLS 

700 

372 

PRINT*,  ' "STORING"  MODE  DISCONTINUED' 

SWALLS 

701 

373 

* 

SWALLS 

702 

374 

***  CHECK  VALIDITY  OF  ANSWER 

SWALLS 

703 

375 

ELSE  IF  ( ( ANSWER  .NE.  1 ) AND.  < ANSWER  .NE.  2 ) ) THEN 

SWALLS 

704 

376 

GOTO  600 

SWALLS 

705 

377 

* 

SWALLS 

706 

378 

END  IF 

SWALLS 

707 

379 

END  IF 

SWALLS 

708 

380 

* 

SWALLS 

709 

PVAl 

7 1 0 

382 

***  END  PROGRAM  WITHOUT  STORING  DATA  *** 

SWALLS 

7 11 

RVAT 

7 1 2 

384 

IF  ( COMMAND  . EQ . 7 ) THEN 

SWALLS 

7 13 

148 


FTN  5 U552 
SUBROUTINE  MANIP 


17 


83/12/24  11.29.48  PAGE 

74/175  OPT=0 


3 85 

700  PRINT* 

SWALLS 

7 

386 

PRINT* , 'DOUBLE  CHECK  ! ! ! ' 

SWALL3 

7 

387 

PRINT*,  • DO  YOU  WANT  TO  END  THIS  PROGRAM 

SWALLS 

7 

388 

+ 'WITHOUT  STORING  DATA?' 

SWALLS 

7 

389 

PRINT*,  ' ENTER  A NUMBER:  (1)  YES  <2)  NO' 

SWALLS 

7 

390 

REWIND  1 

SWALLS 

7 

39  1 

READ! 1, *,END=700)  ANSWER 

SWALLS 

7 

392 

t 

SWALLS 

7 

39  3 

***  SET  FLAG  FOR  ABORTING  PROGRAM  IN  THE  MAIN  PROGRAM 

SWALLS 

7 

394 

IF  ( ANSWER  EQ.  1 ) THEN 

SWALLS 

7 

395 

ABORT  = 1 

SWALLS 

7 

396 

RETURN 

SWALLS 

7 

397 

« 

SWALLS 

7 

398 

***  ABORT  'STORING'  MODE 

SWALLS 

7 

399 

ELSE  IF  ( ANSWER  , EQ . 2 ) THEN 

SWALLS 

7 

400 

PRINT* 

SWALLS 

7 

40  1 

PRINT*,  ' "ABORTION"  MODE  DISCONTINUED' 

SWALLS 

7 

402 

* 

SWALLS 

7 

403 

***  CHECK  VALIDITY  OF  ANSWER 

SWALLS 

7 

404 

ELSE  IF  ( ( ANSWER  .NE.  1 ) .AND.  ( ANSWER  . NE . 2 ) 

) THEN 

SWALLS 

7 

405 

GOTO  700 

SWALLS 

7 

406 

* 

SWALLS 

7 

40  7 

END  IF 

SWALLS 

7 

408 

END  IF 

SWALLS 

7 

409 

A 

SWALLS 

7 

4 10 

« 

- SWALLS 

7 

41  1 

***  LOOP  TO  BEGINNING  OF  'MANIP'  SUBROUTINE 

SWALLS 

7 

4 12 

- SWALLS 

7 

413 

GOTO  10 

SWALLS 

7 

4 14 

A 

SWALLS 

7 

41  5 

END 

SWALLS 

7 

VARIABLE 

MAP-- 

(LO=A) 

NAME---ADDRESS 

--BLOCK 

-PROPERTIES 

TYPE 

ABORT 

2 

DUMMY-ARG 

INTEGER 

ANSWER 

222  7B 

INTEGER 

COMMAND 

223  7B 

INTEGER 

DIR 

NONE 

UNUSED/*S* 

CHAR*3 

DOK 

NONE 

UNUSED/*S* 

INTEGER 

FLAGl 

2230B 

INTEGER 

FROM 

NONE 

UNUSED/*S* 

CHAR*3 

INSERT 

NONE 

UNUSED/*S* 

INTEGER 

LOK 

NONE 

UNUSED/*S* 

INTEGER 

MAT 

NONE 

UNUSED/*S* 

CHAR*3 

N 

223  IB 

INTEGER 

NOK 

NONE 

UNUSED/*S* 

INTEGER 

OK 

223  2B 

INTEGER 

OKI 

2233B 

INTEGER 

OK2 

223  4B 

INTEGER 

QUIT 

1 

DUMMY-ARG 

INTEGER 

TEMP 

NONE 

UNUSED/*S* 

INTEGER 

TO 

NONE 

UNUSED/*S* 

CHAR*3 

V 

NONE 

UNUSED/*S* 

INTEGER 

WALL 

OB 

/WALLC/ 

CHAR*3 

WDIM 

OB 

/WALLN/ 

REAL 

WERR 

34  2B 

/WALLN/ 

INTEGER 

VTOT 

34  IB 

/WALLN/ 

INTEGER 

X 

2235B 

INTEGER 

Y 

223  6B 

INTEGER 

' 1 4 

15 

'U 

17 

'18 

19 

'20 

21 

'22 

23 

'24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 
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SUBROUTINE  MANIP  74/175  OPT=0 

-SYMBOLIC  CONSTANTS--(LO=A> 

-NAME TYPE VALUE 

WMAX  INTEGER  75 


-PROCEDURES-- ( LO=A) 

-NAME TYPE ARGS CLASS 

DATA  IN  2 SUBROUTINE 

DISPLAY  2 SUBROUTINE 


-STATEMENT  LABELS-- ( LO=A ) 


LABEL- 

ADDRESS 

--PROPERTIES- 

---DEF 

-LABEL- 

ADDRESS 

--PROPERTIES-- 

10 

7B 

35 

300 

61  IB 

100 

SOB 

61 

305 

66  0B 

200 

16  IB 

1 1 7 

310 

INACTIVE 

DO-TERM 

210 

INACTIVE 

DO-TERM 

142 

320 

INACTIVE 

DO-TERM 

220 

INACTIVE 

DO-TERM 

145 

330 

INACTIVE 

DO-TERM 

230 

INACTIVE 

DO-TERM 

146 

500 

1003B 

250 

INACTIVE 

DO-TERM 

217 

510 

1 035B 

260 

INACTIVE 

DO-TERM 

220 

600 

1 0 7 6B 

270 

INACTIVE 

DO-TERM 

221 

700 

1 150B 

-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS- -ARGS 

MANIP  5B  2 


-I  10  UNITS--(LO  = A) 
-NAME---  PROPERTIES 

TAPEl  PMT/SEQ 


-STATISTICS-- 


PROCRAM-UNIT  LENGTH 

2253B 

= 1195 

CM  LABELLED  COMMON  LENGTH 

47  5B 

= 317 

CM  STORAGE  USED 

6S000B 

= 27136 

COMPILE  TIME 

0.625 

SECONDS 

•DEF 

240 

264 

273 

276 

277 

314 

329 

355 

385 
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1 SUBROUTINE  DISPLAY  (LINE,  COMMAND)  SVALL5 

3 •*»  COMMON  FOR  DATABASE  OF  WALL  PARAMETERS  ***COMV 

5 INTEGER  UMAX  COMV 

6 PARAMETER  (WMAX  = 75)  COMV 

7 COMMON  /WALLN/  WD IM< WMAX , 3 ) , VTOT,  WERR  COMU 

8 COMMON  /WALLC/  WALL (WMAX, 4)  COMW 

9 INTEGER  WTOT.WERR  COMW 

10  REAL  WDIM  COMW 

11  CHARACTER  *3  WALL  COMW 

12  * =================================  COMW 

13  •»  DESCRIPTION  OF  ARRAYS  COMU 

14  * =================================  COMW 

15  * WALL  IDENTIFICATION  COMU 

U » COMW 

17  * DIRECTION  FROM  TO  COMW 

18  * ROOM  ROOM  COMU 

19  » COMW 

20  * WALL(X,1)  UALL(X,2)  WALL(X,3)  COMW 

21  * A3  A3  A3  COMU 

22  * =========================================================  COMV 

23  * WALL  PARAMETERS  COMU 

29  » COMW 

25  « MATERIAL  HEIGHT  WIDTH  LAYER  THICKNESS  COMU 

26  * - COMW 

27  * WALL(X,4)  VDIM(X,1)  VDIM(X,2)  WDIM(X,3)  COMU 

28  * A3  F8.2  F8 . 2 F8 . 2 COMW 

31  INTEGER  LINE,  COMMAND,  N SVALLS 

32  1000  FORMAT  (8(3X,A))  SWALLS 

33  20  00  FORMAT  ( 4 X , I 3 , 8X  , A3  , 7X  , A3  , 3X , A3  , 2 X , F6  . 2 , 2X  , F6  . 2 , 5X  , F 6 . 2 , 7X  , A3  ) SWALLS 

34  PRINT  1 000,  'LINE  # ' , ’ D I RECTI  ON ' , ' FROM ' , ' TO ' , ' HE  I GHT ' , SWALLS 

35  + 'WIDTH' , 'THICKNESS' , 'MATERIAL ' SVALLS 

36  IF  ( COMMAND  . EQ  4 ) THEN  SWALLS 

37  DO  10  N = l,WTOT  SWALLS 

38  PRINT  2000,  N , WALL ( N , 1 ) , WALL ( N , 2 ) , WALL (N , 3 ) , WD IM (N , 1 ) , SVALLS 

39  + WDIM(N, 2) ,WDIM(N, 3) ,WALL(N, 4)  SVALLS 

40  10  CONTINUE  SWALLS 

41  ELSE  SVALLS 

42  PRINT  2000,  L INE , WALL ( L I NE , 1 ) , WALL ( L I NE , 2 ) , WALL ( L I NE , 3 ) , SVALLS 

43  + WDIM(LINE, 1) ,WDIM(LINE,2) ,WDIM(LINE,3) , WALL(LINE,4)  SWALLS 

44  END  IF  SWALLS 

45  RETURN  SWALLS 

46  END  SWALLS 


745 


4 

5 

6 

7 

8 
9 

1 0 
1 1 
1 2 
1 3 
1 4 

1 C 

1 6 
17 
1 8 

19 

20 

21 

n »» 
i.  u 

23 

24 

25 

26 

27 

28 

2 9 
7 47 
7 48 

749 

750 
75  1 

752 

753 

754 

755 

756 

757 

758 

759 

760 

761 

762 


VARIABLE 

MAP-- 

o 

II 

> 

NAME---ADDRESS 

--BLOCK PROPERTIES 

TYPE 

---SIZE 

COMMAND 

2 

DUMMY -ARG 

INTEGER 

LINE 

1 

DUMMY-ARG 

INTEGER 

N 

2 4 4B 

INTEGER 

WALL 

OB 

/WALLC/ 

CHAR*3 

300 

WDIM 

OB 

/WALLN/ 

REAL 

225 

WERR 

342B 

/WALLN/ 

INTEGER 

VTOT 

341B 

/WALLN/ 

INTEGER 

151 
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SUBROUTINE  DISPLAY  74/175  OPT 

-SYMBOLIC  CONSTANTS--! LO=A) 
-NAME TYPE 

WMAX  INTEGER 


-STATEMENT  LABELS-- ( LO=A ) 

-LAB  EL- ADDRESS PROPERTIES-- 

10  INACTIVE  DO-TERM 

1000  150B  FORMAT 

2000  152B  FORMAT 


-ENTRY  POINTS--(LO=A) 
-NAME---ADDRESS--ARGS--- 

DISPLAY  5B  2 


-STATISTICS-- 

PROCRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED  6 

COMPILE  TIME  0 


.29.46  PACE 
:0 


VALUE 

75 


-DEF 

40 

32 

33 


250B  = 168 

475B  = 317 

OOOB  = 25088 

085  SECONDS 
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1 

INTEGER  FUNCTION  VAL(STRING) 

SUALLS 

76 

2 C»* 

RETURNS  THE  INTEGER  VALUE  OF  A STRING. 

SWALLS 

76 

3 

INTEGER  NUMBER,  X , L , EXP , D I G IT , GETLEN 

SUALLS 

76 

4 

CHARACTER  » (*)  STRING 

SUALLS 

7 6 

5 

L = GETLEN(STRING) 

SUALLS 

76 

6 

NUMBER  = 0 

SUALLS 

76 

7 

DO  10  X = L, 1 ,-l 

SUALLS 

76 

8 

EXP  = L - X 

SUALLS 

77 

9 

DIGIT  = ICHAR(STRING(X: X) ) - 16 

SUALLS 

77 

10 

NUMBER  = NUMBER  + D I G IT* 1 0 * »EXP 

SUALLS 

77 

11  10 

CONTINUE 

SUALLS 

77 

12 

VAL  = NUMBER 

SUALLS 

77 

13 

RETURN 

SUALLS 

77 

14 

END 

SUALLS 

77 

-VARIABLE  MAP--(LO=A) 


-NAME-- 

-ADDRESS-- 

BLOCK PROPERTIES 

-TYPE 

DIGIT 

76B 

INTEGER 

EXP 

75B 

INTEGER 

L 

74B 

INTEGER 

NUMBER 

72B 

INTEGER 

STRING 

1 

DUMMY-ARG 

CHAR* ( *) 

VAL 

71B 

INTEGER 

X 

73B 

INTEGER 

-PROCEDURES--(LO= 

A) 

-NAME-- 

TYPE-- 

ARGS 

--CLASS 

GETLEN 

INTEGER  1 

FUNCTION 

ICHAR 

INTEGER  1 

INTRINSIC 

-STATEMENT  LABELS 

--(LO=A) 

-LABEL-, 

ADDRESS--- 

--PROPERTIES-- 

--DEF 

10 

INACTIVE 

DO-TERM 

11 

-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS- -ARCS 

VAL  6B  1 


-STATISTICS-- 

PROGRAM-UNIT  LENGTH  102B  = 66 

CM  STORAGE  USED  61000B  = 25088 

COMPILE  TIME  0.039  SECONDS 


,3 

i4 

,5 

6 

.7 

8 

.9 

0 

'1 

2 

'3 

4 

5 

6 
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FUNCTION  GETLEN  78/175  OPT=0 

1 

INTEGER  FUNCTION  GETLEN  (STRING) 

SUALLS 

n 

2 

c 

SUALLS 

7 

3 

c 

DETERMINE  LENGTH  OF  STRING  EXCLUDING  ANY  BLANK  PADDING 

SUALLS 

7 

8 

c 

SUALLS 

7 

5 

c 

SUALLS 

7 

4 

c 

ARGUMENT  DEFINITIONS  -- 

SUALLS 

7 

7 

c 

READ  ARGUMENTS 

SUALLS 

7 

e 

c 

STRING  - STRING  WHOSE  LENGTH  IS  TO  BE  DETERMINED 

SUALLS 

7 

9 

c 

SUALLS 

7 

10 

CHARACTER  * (*)  STRING 

SUALLS 

7 

11 

c 

SUALLS 

7 

12 

c 

FUNCTION  PARAMETERS 

SUALLS 

7 

13 

CHARACTER  * 1 BLANK 

SUALLS 

7 

18 

PARAMETER  (BLANK  = ' ' ) 

SUALLS 

7 

15 

c 

SUALLS 

7 

14 

c 

LOCAL  VARIABLES 

SUALLS 

7 

17 

INTEGER  NEXT 

SUALLS 

7 

18 

c 

SUALLS 

7 

19 

c 

START  WITH  THE  LAST  CHARACTER  AND  FIND  THE  FIRST  NON-BLANK 

SUALLS 

n 

20 

DO  10  NEXT  = LEN(STRING) , 1 , -1 

SUALLS 

7 

21 

IF  (STRING(NEXT  : NEXT)  .NE.  BLANK)  THEN 

SUALLS 

7 

22 

GETLEN  = NEXT 

SUALLS 

7 

23 

RETURN 

SUALLS 

7 

28 

END  IF 

SUALLS 

8 

25 

10  CONTINUE 

SUALLS 

8 

24 

c 

SUALLS 

8 

27 

c 

ALL  CHARACTERS  ARE  BLANKS 

SUALLS 

8 

28 

GETLEN  = 0 

SUALLS 

8 

29 

c 

SUALLS 

8 

30 

RETURN 

SUALLS 

8 

31 

END 

SUALLS 

8 

-VARIABLE  MAP--(LO=A) 

-NAME- --ADDRESS- -BLOCK PROPERTIES TYPE- SIZE 

GETLEN  63B  INTEGER 

NEXT  64B  INTEGER 

STRING  1 DUMMY-ARG  CHAR*<*) 


-SYMBOLIC  CONSTANTS--( LO=A) 

-NAME TYPE-- --VALUE 

BLANK  CHAR*1  ' ' 


-PROCEDURES--(LO=A) 

-NAME TYPE ARCS CLASS 

LEN  INTEGER  1 INTRINSIC 


-STATEMENT  LABE LS- - ( L0= A ) 

-LABEL -ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  25 


78 

79 

80 

81 

82 

83 

88 

35 

84 

37 

88 

89 

90 

9 1 

92 

93 

98 

95 

94 

97 

98 

99 

00 

0 1 

02 

03 

08 

05 

04 

07 
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FUNCTION  CETLEN  74/175  OPT=0 

-ENTRY  POINTS--(LO=A) 

-NAME ---ADDRESS-- ARCS- -- 

CETLEN  AB  1 


-STATISTICS-- 

PROCRAM-UNIT  LENGTH  70B 
CM  STORAGE  USED  AlOOOB 
COMPILE  TIME  0.037 


& PAGE 


= 56 

= 25088 

SECONDS 
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FTN  5 . 1+5S2 
SUBROUTINE  LWALL 


BSmiZA.  1 1 .29.46  PAGE 
74/175  OPT=0 


24 


1 

2 * ! ! 

3 * ! ! 

4 * ! ! 

5 * ! ! 

6 * ! ! 
7 


SUBROUTINE  LWALL  LWALL 

M ! M ! ! ! ! I !!  ! ! ! ! ! j ! ! ! ! f j ! ! j j j ! ! I ! ! ! ! I I ! j jj  ! ! ! ! j { ! I j j ! I j ! j I j j j ! ! j M j j ^ ^ 

! ! ! LWALL 

LOAD  THE  CONTENTS  OF  THE  PILE  'WALLS'  INTO  ARRAYS  WALL  AND  WDIM.  LWALL 

! ! ! LWALL 

! N !!!!!!!!!!!!!!!!!!!!!!  M !!  M !!  I j j ! j ! j !!!  j ! j j !!!  j !!  I I j j ! I!  j !!  j I M I I, 


9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 


***  COMMON  FOR  DATABASE  OF  WALL  PARAMETERS 


INTEGER  WMAX 
PARAMETER  (WMAX  = 75) 

COMMON  /WALLN/  WDIM(WMAX,3) 
COMMON  /WALLC/  WALL (WMAX, 4) 
INTEGER  WTOT,WERR 
REAL  WDIM 
CHARACTER  *3  WALL 

* DESCRIPTION  OF  ARRAYS 
WALL  IDENTIFICATION 


WTOT,  WERR 


DIRECTION 


FROM 

ROOM 


TO 

ROOM 


WALL(X,1) 

A3 


WALL(X,2) 

A3 


WALL (X, 3) 
A3 


WALL  PARAMETERS 


MATERIAL 


HEIGHT 


WIDTH 


LAYER  THICKNESS 


***COMW 

COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 
COMW 


WALL (X, 4)  WDIM(X, 1)  WDIMCX, 2)  WDIM( X, 3) 

A3  F8.2  F8.2  F8.2 

*«**«  ft  « **«***««*  A ft  *««***«  A * ft  t ««**  ft  * 1 1 ft  ********  ft  *«*«  ft  ««  ft  t ««*  )t  * ft  «**««  CONV 

ftftft ftftftftft ftftftftftftftftftftftftft ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftCONF 


1 

2 

3 

4 

5 

6 
7 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 
29 

1 


38 

»*  COMMON  FOR  INITIAL  PARAMETERS 

***COMF 

2 

39 

ft  Aft  ft** Aft ftftft ftftftft Aft  Aft ftftftftft Aft* ftftftftftftft ftftft ftftftftft ftftft ftftftftft Aft ftftftft Aft ftftftftftftftftftftftftftCOMF 

3 

40 

INTEGER  FMAX 

COMF 

4 

41 

PARAMETER  (FMAX  = 50) 

COMF 

5 

42 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX), 

FERR,  COMF 

6 

43 

5 FTOT 

COMF 

7 

44 

COMMON  /INITILC/  BLDG 

COMF 

8 

45 

CHARACTER  * 5 BLDG 

COMF 

9 

46 

REAL  FREQ,  AFLAG,  RFLAG,  FREQA 

COMF 

10 

47 

INTEGER  QUALITY,  FERR,  FTOT 

COMF 

11 

48 

««« ************************************** ******************************* COMP 

12 

49 

*************************** ********** t ****** ****««**** *«*«**«**««*«***** COMP 

13 

SO 

************************************************** 

LWALL 

10 

51 

ft 

DECLARATION  OF  VARIABLES 

LWALL 

11 

52 

************************************************** 

LWALL 

12 

S3 

INTEGER  GETLEN,  R,  C 

LWALL 

13 

54 

CHARACTER  * 7 NAME,  PFN 

LWALL 

14 

55 

************************************************** 

LWALL 

15 

56 

ft 

LWALL 

16 

57 

************************************************** 

LWALL 

17 

58 

NAME  = 'B' / /BLDGd  ;GETLEN(BLDG)) // 'W' 

LWALL 

18 

59 

PFN  = NAME  (1 :GETLEN(NAME) ) 

LWALL 

19 

60 

WERR  = 0 

LWALL 

20 

61 

CALL  PF  ( 'GET' ,0,PFN( 1 :GETLEN(PFN) ), 'RC , WERR) 

LWALL 

21 

62 

IF  ( WERR  .EQ.  0 ) THEN 

LWALL 

22 

63 

OPEN  (UNIT=3,  FILEoPFN,  FORM= ' FORMATTED ' , 

LWALL 

23 

64 

$ STATUSn'OLD' , ACCESS= ' SEQUENTIAL ' ) 

LWALL 

24 
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SUBROUTINE  LVALL 


83  / 1 2 / 2 4.  1 1 .29.46  PACE 
74/175  OPT=0 


25 


65 

1000 

FORMAT  ( IX,  4(  IX , A3 ) , 3( IX. F8 . 2) ) 

LWALL 

25 

66 

WTOT  = 0 

LWALL 

26 

67 

DO  10  R = l.WMAX 

LWALL 

27 

66 

READ  (3 , 1000 ,END=20) <WALL(R,C) ,C=1,4),(VDIM(R,C),C=1,3) 

LWALL 

28 

69 

WTOT  = WTOT  + 1 

LWALL 

29 

70 

10 

CONTINUE 

LWALL 

30 

71 

20 

CONTINUE 

LWALL 

31 

72 

CLOSE ( 3 , STATUS= ' DELETE ' ) 

LWALL 

32 

73 

ELSE  IF  ( WERR  EQ.  2 ) THEN 

LWALL 

33 

74 

CALL  WARNING  (7) 

LWALL 

34 

75 

ELSE 

LWALL 

35 

76 

CALL  WARNING  (8) 

LWALL 

36 

77 

END  IF 

LWALL 

37 

78 

RETURN 

LWALL 

38 

79 

END 

LWALL 

39 

VARIABLE 

MAP-- 

(LO=A) 

NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

---SIZE 

AFLAC 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR* 5 

C 

2S5B 

INTEGER 

FERR 

666 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTOT 

67B 

/ INITILN/ 

INTEGER 

NAME 

256B 

CHAR*7 

PFN 

257B 

CHAR*7 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

254B 

INTEGER 

RFLAC 

3B 

/ INITILN/ 

REAL 

WALL 

OB 

/WALLC/ 

CHAR*3 

300 

WDIM 

OB 

/WALLN/ 

REAL 

225 

WERR 

342B 

/WALLN/ 

INTEGER 

WTOT 

341B 

/WALLN/ 

INTEGER 

-SYMBOLIC  CONSTANTS-- (LO=A) 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

WMAX  INTEGER  75 


-PROCEDURES 

--(LO=A) 

-NAME 

TYPE 

--ARCS--- 

---CLASS 

GETLEN 

INTEGER 

1 

FUNCTION 

PF 

5 

SUBROUTINE 

WARNING 

1 

SUBROUTINE 

-STATEMENT  LABELS--! LO=A) 

-LABEL -ADDRESS PROPERTIES DEF 


10  INACTIVE  DO-TERM 

20  117B 

1000  155B  FORMAT 


70 

71 
65 
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SUBROUTINE  LWALL  74/175  OPT=0 

-ENTRY  POINTS--! LO=A) 

-NAME ADDRESS-- ARCS 

LWALL  5B  0 


-I/O  UNITS--(LO=A) 
-NAME PROPERTIES- 

TAPE3  AUX/FMT/SEQ 


-STATISTICS-- 


PROCRAM-UNIT  LENGTH 

265B 

= 181 

CM  LABELLED  COMMON  LENGTH 

566B 

= 374 

CM  STORAGE  USED 

63000B 

= 26112 

COMPILE  TIME 

0.105 

SECONDS 
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SUBROUTINE  WARNING  74/175  OPT=0 


SUBROUTINE  WARNING(ERR) 
INTEGER  ERR,  ERRM 
CHARACTER*45  MESSAGE(20) 


WARNING 

WARNING 

WARNING 


4 

DATA 

MESSAGE!  1)/'"H0LE"  DATA  FILE  DOES 

NOT  EXIST 

FOR  THIS 

BLDG  ' / 

WARNING 

n 

5 

DATA 

MESSAGE!  2) /'FILE  HANDLING  PROBLEM 

ON  "HOLE" 

DATA  FILE 

' / 

WARNING 

5 

6 

DATA 

MESSAGE!  3) /'"MATTER"  FILE  DOES  NOT 

EXIST  FOR 

THIS  BLDG  ' / 

WARNING 

6 

7 

DATA 

MESSAGE!  4)/'FILE  HANDLING  PROBLEM 

ON  "MATTER 

FILE 

' / 

WARNING 

7 

8 

DATA 

MESSAGE!  5)/ '"TYPE"  DATA  FILE  DOES 

NOT  EXIST 

FOR  THIS 

BLDG ' / 

WARNING 

8 

9 

DATA 

MESSAGE!  6) /'FILE  HANDLING  PROBLEM 

ON  "TYPE" 

FILE 

' / 

WARNING 

9 

1 0 

DATA 

MESSAGE!  7)/ '"WALL"  DATA  FILE  DOES 

NOT  EXIST 

FOR  THIS 

BLDG ' / 

WARNING 

10 

1 1 

DATA 

MESSAGE!  8) /'FILE  HANDLING  PROBLEM 

ON  “WALL" 

FILE 

' / 

WARNING 

1 1 

1 2 

DATA 

MESSAGE!  9)/ 'HEIGHT  AND  WIDTH  OF  ROOM  MISSING 

' / 

WARNING 

1 2 

13 

DATA 

MESSAGE! 10 )/' LENGTH  OF  ROOM  IS  MISSING 

' / 

WARNING 

1 3 

1 4 

DATA 

MESSAGE! 11  )/  'FREQ  FILE  DOES  NOT  EXIST  FOR  THIS  BLDG 

' / 

WARNING 

1 4 

15 

DATA 

MESSAGE!  12  )/ ‘ FILE  HANDLING  PROBLEM 

WITH  FREQ 

FILE 

' / 

WARNING 

1 5 

1 6 

DATA 

MESSAGE! 13 )/ 'WARNING  CODE  IS  OUT  OF 

RANGE 

' / 

WARNING 

16 

17 

DATA 

MESSAGE! 14) / 'WARNING  CODE  IS  OUT  OF 

RANGE 

' / 

WARNING 

1 7 

1 8 

DATA 

MESSAGE! 15 )/ 'WARNING  CODE  IS  OUT  OF 

RANGE 

' / 

WARNING 

18 

19 

DATA 

MESSAGE! 16 )/ 'WARNING  CODE  IS  OUT  OF 

RANGE 

' / 

WARNING 

19 

20 

DATA 

MESSAGE! 17 )/ 'WARNING  CODE  IS  OUT  OF 

RANGE 

' / 

WARNING 

2 0 

21 

DATA 

MESSAGE!18)/ 'WARNING  CODE  IS  OUT  OF 

RANGE 

' / 

WARNING 

2 1 

22 

DATA 

MESSAGE! 19 )/ 'WARNING  CODE  IS  OUT  OF 

RANGE 

' / 

WARNING 

22 

23 

DATA 

MESSAGE!20)/ 'WARNING  CODE  IS  OUT  OF 

RANGE 

' / 

WARNING 

23 

24 

ERRM= 

:12 

WARNING 

24 

25 

lERR 

= ERR 

WARNING 

25 

26 

IF(ERR.GT.ERRM)  IERR=20 

WARNING 

26 

27 

WRITE (6, 20) 

WARNING 

27 

28 

WRITE(6,10)  ERR, MESSAGE! lERR) 

WARNING 

28 

29 

WRITE(6,20) 

WARNING 

29 

30 

10 

FORMAT!'  ***WARNING  NUMBER  = ',15,'  *** 

' , A45 ) 

WARNING 

30 

31 

20 

FORMAT!'  ') 

WARNING 

31 

32 

RETURN 

WARNING 

32 

33 

END 

WARNING 

33 

-VARIABLE  MAP--(LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


ERR 

1 DUMMY-ARG 

ERRM 

60B 

lERR 

21  3B 

MESSAGE 

61B 

INTEGER 

INTEGER 

INTEGER 

CHAR*45  20 


-STATEMENT  LABELS-- ( LO=A ) 

-LAB  EL -ADDRESS PROPERTIES DEF 

10  34B  FORMAT  30 

20  42B  FORMAT  31 


FTN  5.1+552  83/12/24.  11  29.46  PACE  20 

SUBROUTINE  WARNING  74/175  OPT=0 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS- -ARGS--- 

WARNING  5B  1 


--I/O  UNITS--(LO=A) 
-NAME PROPERTIES 

TAPE6  FMT/SEQ 


--STATISTICS-- 

FROGRAM-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


21  6B  < 142 

61000B  ^ 25088 

0.060  SECONDS 
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PAGE 

29 

SUBROUTINE 

ERROR 

74/175  OPT 

= 0 

1 

SUBROUTINE  CRROR(IERR) 

ERROR 

. 

7 

CHARACTER*45  MESSAGE(20) 

ERROR 

2 

3 

DATA 

MESSAGE!  1)/ 

' MATERIALS 

DATA 

, EASE 

IS  EMPTY 

' / 

ERROR 

.3 

4 

DATA 

MESSAGE!  2)1 

' FREQUENCY 

IS  OUT  1 

DF 

RANGE 

' / 

ERROR 

4 

5 

DATA 

MESSAGE!  3)/ 

'THIS 

MATERIAL 

IS  1 

NOT 

IN  DATA  EASE 

' / 

ERROR 

5 

6 

DATA 

MESSAGE!  4)/ 

'DENOMINATOR  IS 

ZERO 

' / 

ERROR 

7 

DATA 

MESSAGE!  5)/ 

■FILE 

HANDL 

ING 

ERROR 

' / 

ERROR 

7 

e 

DATA 

MESSAGE!  6)1 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

e 

7 

DATA 

MESSAGE!  7)1 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

9 

1 0 

DATA 

MESSAGE!  8)/ 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' ; 

ERRCR 

C 

11 

DATA 

MESSAGE!  9)/ 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

1 1 

1 L 

DATA 

MESSAGE!  10  ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

1 2 

13 

DATA 

MESSAGE! 1 1 ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

13 

1 4 

DATA 

MESSAGE ! 12)/ 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

1 4 

15 

DATA 

MESSAGE  ! 1 3 ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

1 5 

1 6 

DATA 

MESSAGE!  14)  / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

16 

17 

DATA 

MESSAGE ! 15 ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

17 

1 8 

DATA 

MESSAGE! 16)/ 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

18 

19 

DATA 

MESSAGE  ! 17  ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

1 9 

20 

DATA 

MESSAGE! 18)/ 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

2G 

21 

DATA 

MESSAGE! 19  ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

: 1 

22 

DATA 

MESSAGE! 20 ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

22 

23 

IERRM=5 

ERROR 

23 

24 

IF( lERR  GT. lERRM) 

IERR  = 

20 

ERROR 

24 

2 5 

URITE(6,10)  lERR, 

MESSAGE ! lERR) 

ERROR 

25 

26  10 

FORMAT!'  *** ERROR 

NUMBER  = ' 

, 15  , 

‘ * * * 

' ,A45) 

ERROR 

2 

27 

CALL 

PMDSTOP 

ERROR 

2 ? 

28 

STOP 

' ERROR ' 

ERROR 

28 

29 

END 

ERROR 

2? 

-VARIABLE  MAP--!LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES 

TYPE 

SIZE 

lERR  1 DUMMY-ARC 

INTEGER 

lERRM  210B 

INTEGER 

MESSAGE  56B 

CHAR*  45 

20 

-PROCEDURES--(LO=A) 

-NAME TYPE --ARCS CLASS 

PMDSTOP  0 SUBROUTINE 


-STATEMENT  LABELS-- ( LO=A) 

-LAE  EL -ADDRESS PROPERTIES DEE 

10  36B  FORMAT  26 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS- -ARCS 

ERROR  5B  1 


FTN  5.1+552  83/12/24.  11.29  46  PAGE  30 

SUBROUTINE  ERROR  74/175  OPT=0 

--I/O  UNITS--(LO=A) 

-NAME PROPERTIES 

TAFE6  FMT/SEQ 


--STATISTICS-- 

PROGRAM-UNIT  LENGTH  213B  = 139 

CM  STORAGE  USED  61000B  = 25088 

COMPILE  TIME  0.056  SECONDS 
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FTN  5 1+552  83/12/24.  10  34.12  PAGE  1 

PROGRAM  3TYPES  74/175  OPT=0 

1 PROGRAM  STYPE3  ( INPUT , TAPE  1 = I NPUT)  STYPES 

2 * STYPES 

3 *THI3  INTERACTIVE  PROGRAM  INPUTS  THE  DATA  DESCRIBING  EACH  TYPE  STYPES 

4 *IN  THE  BUILDING  AND  STORES  IT.  THE  FILE  NAME  IS  CREATED  BY  STYPES 

5 ‘ATTACHING  "B"  TO  THE  FRONT  OF  AND  "W"  TO  THE  BACK  OF  THE  BUILDING  STYPES 

4 ‘IDENTIFICATION.  THE  BUILDING  IDENTIFICATION  CAN  BE  NO  MORE  STYPES 

7 ‘THAN  5 ALPHANUMERIC  CHARACTERS.  STYPES 

8 STYPES 

9 ******»********************A*********************<t*******»*******!i(******coj'ij' 

10  ***  COMMON  FOR  INITIAL  PARAMETERS  ***COMF 

I \ 1 1 * t t It  t 1 1 1 1 1 * 1 1 t * it  * 1 1 * It  h 1 1 1 1 1 1 1 1 * * i(  It  1 1 1 h * 1 1 1 1 1 1 * 1 1 1 1 1 1 1 1 1 1(  * * 1 1 1 M 1 t H t t * Q 

12  INTEGER  FMAX  COMF 

13  PARAMETER  (FMAX  = 50)  COMF 

14  COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR,  COMF 

15  $ FTOT  COMF 

14  COMMON  /INITILC/  BLDG  COMF 

17  CHARACTER  ‘ 5 BLDG  COMF 

18  REAL  FREQ,  AFLAC,  RFLAG,  FREQA  COMF 

17  INTEGER  QUALITY,  FERR,  FTOT  COMF 

20  1 1 it  1 1 1 it  It  h t * t It  it  t It  It  It  1 1 h 1 1 It  It  It  t it  t It  t it  t It  t * It  1 1 1 1 t tit  t it  t it  1 1 1 it  it  it  t 1 1 It  it  t It  t It  it  t k t it  t It  t 

21  t * 1 1 it  1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 * 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 * 1 1 1 1 1 1 * 1 1 1 1 1 1 1 1 1 1 1 1 1 t * 1 1 

23  ***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  ***COMR 

24  t t t t t t t t t 1 1 t t t t t t t t t t t t 1 1 1 1 t t t t t t t t t 1 1 t t t t t t t t t 1 1 t t t t t t t t t t t t t t 1 1 1 1 t t t t t 

25  INTEGER  RMAX  COMR 

24  PARAMETER  (RMAX  = 20)  COMR 

27  COMMON  /ROOMN/  ROOM(RMAX  + 4,  RMAX  + 4),  NROOMS,  RAREA(RMAX)  COMR 

28  INTEGER  NROOMS  COMR 

29  REAL  ROOM  COMR 

30  tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt COMR 

31  ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt *C0MR 

32  ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt * COMT 

33  *“  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  “‘COMT 

34  *tit*ii*****iiii*i(*iit*iit*ii*iii(tt***t*ii**iiiit*ii**t*****t****ii***ii*t***ttt***ii*iic  OMT 

35  INTEGER  TMAX  COMT 

34  PARAMETER  (TMAX=35)  COMT 

37  COMMON  /TYPEN/TDIM(TMAX , 4) ,TTOT,TDB2 (TMAX , 2 ) ,TDBTOT,TERR  COMT 

38  COMMON  /TYPEC/TYPE(TMAX,3) ,TDB1(TMAX)  COMT 

39  INTEGER  TTOT , TDETOT , TERR  COMT 

40  REAL  TDIM,TDB2  COMT 

41  CHARACTER  * 3 TYPE,TDB1  COMT 

42  ‘=================================================  COMT 

43  * DESCRIPTION  OF  ARRAYS  COMT 

44  ‘================================3================  COMT 

45  * ID  MATERIAL  FRAME  MATERIAL  COMT 

46  * COMT 

47  *TYPE(X,1)  TYPE(X,2)  TYPE(X,3)  COMT 

48  ‘ A3  A3  A3  COMT 

49  ‘3==33======3333=3=3=333=3=3===3==3=============3=  COMT 

50  ‘ HEIGHT  WIDTH  LAYER  DISTANCE  COMT 

51  * THICKNESS  ABOVE  FLOOR  COMT 

52  * COMT 

53  * TDIM(X,1)  TDIM(X,2)  TDIM(X,3)  TDIM(X,4)  COMT 

54  * F8  . 2 F8  . 2 F8  . 2 F8  . 2 COMT 

55  «======3======================3=3======33=3=======  COMT 

54  * ID  ATTENUATION  AREA  COMT 

57  * COMT 

58  * TDBKX)  TDB2(X,1)  TDB2(X,2)  COMT 

59  * A3  E9.3  E9  3 COMT 

60  *********(t***********‘**‘‘**‘‘‘“‘*‘“‘‘““““““‘““*““‘“““*“  COMT 

42  INTEGER  GETL EN , QU IT , ABORT , ANSWER , OLDF I LE , N , Y 1 , Y2 , L I NE  STYPES 

43  INTEGER  lERR  STYPES 

44  CHARACTER  ‘ 7 PFN  STYPES 
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65 

t 

STYPES 

15 

66 

• INITIALIZATION 

STYPES 

1 6 

67 

QUIT  = 0 

STYPES 

17 

68 

TTOT  = 0 

STYPES 

18 

69 

ABORT  = 0 

STYPES 

19 

70 

100 

PRINT* 

STYPES 

20 

71 

PRINT  »,  'ENTER  BUILDING  IDENTIFICATION  (E.G.  ''101'')' 

STYPES 

2 1 

72 

PRINT  *,  • (NO  MORE  THAN  5 ALPHANUMERIC  CHARACTERS)' 

STYPES 

22 

73 

REWIND  1 

STYPES 

23 

74 

READd  ,*  ,END=100)  BLDG 

STYPES 

24 

75 

STYPES 

25 

76 

IF  ( GETLEN(BLDG)  GT.  5 ) THEN 

STYPES 

26 

77 

CO  TO  100 

STYPES 

27 

78 

END  IF 

STYPES 

28 

79 

PFN  = 'B'  II  BLDG(1:GETLEN(BLDG) ) II  'T' 

STYPES 

29 

80 

« 

STYPES 

30 

81 

t * « 

LOAD  DATA  ID  EXISTING  FILE  IF  NECESSARY 

STYPES 

31 

82 

200 

PRINT* 

STYPES 

32 

83 

PRINT* , 'WILL  THIS  BE ' 

STYPES 

33 

84 

PRINT*,'  (1)  A MODIFICATION  OF  AN  EXISTING  FILE?' 

STYPES 

34 

85 

PRINT*, ' (2)  A NEW  FILE? ' 

STYPES 

35 

86 

PRINT* ,' ENTER  A NUMBER  !!!' 

STYPES 

36 

87 

REWIND  1 

STYPES 

37 

88 

READ( 1 , * ,END=200)  OLDFILE 

STYPES 

38 

89 

IF  ( ( OLDFILE  .NE.  1 ) .AND.  ( OLDFILE  .NE.  2 ) ) THEN 

STYPES 

39 

90 

GOTO  200 

STYPES 

40 

91 

ELSE  IF  ( OLDFILE  . EQ . 1 ) THEN 

STYPES 

41 

92 

t 

STYPES 

42 

93 

tt  * 

CHECK  FOR  EXISTENCE  OF  PERMANENT  FILE  OF  SAME  NAME 

STYPES 

43 

94 

I ERR  = 0 

STYPES 

44 

95 

CALL  PF  ( 'GET'  ,0,PFN(1 ;GETLEN(PFN) ) , 'RC , lERR) 

STYPES 

45 

96 

IF  ( I ERR  .EQ.  2 ) THEN 

STYPES 

46 

97 

PRINT* 

STYPES 

47 

98 

PRINT  *,  'FILE  ' ,PFN,  ' NOT  FOUND' 

STYPES 

48 

99 

PRINT*,  'PROGRAM  ABORTED! !! ' 

STYPES 

49 

100 

PRINT* 

STYPES 

50 

10  1 

PRINT*,  'FIND  CORRECT  BUILDING  IDENTIFIER  AND  RESTART  ', 

STYPES 

51 

102 

+ 'PROGRAM' 

STYPES 

52 

103 

PRINT* 

STYPES 

53 

104 

STOP 

STYPES 

54 

105 

t 

STYPES 

55 

106 

ELSE 

STYPES 

56 

107 

CALL  LTYPE 

STYPES 

57 

108 

IF  (TERR  NE.  0)  CALL  ERROR(5) 

STYPES 

58 

109 

END  IF 

STYPES 

59 

no 

ELSE  IF  ( OLDFILE  .EQ.  2 ) THEN 

STYPES 

60 

11  1 

n 

STYPES 

61 

112 

•ktt 

CHECK  FOR  EXISTENCE  OF  PERMANENT  FILE  OF  SAME  NAME 

STYPES 

62 

113 

I ERR  = 0 

STYPES 

63 

114 

CALL  PF  ( 'GET' ,0 ,PFN(1 :GETLEN(PFN) ) , 'RC ' , lERR) 

STYPES 

64 

115 

IF  ( lERR  EQ.  0 ) THEN 

STYPES 

65 

1 16 

PRINT* 

STYPES 

66 

117 

PRINT*,  'DATA  FILE  ALREADY  EXISTS  FOR  BUILDING  ',BLDG 

STYPES 

67 

1 18 

PRINT* 

STYPES 

68 

119 

PRINT*, 'IF  YOU  ENTER  DATA  AND  STORE  IT,  YOU  WILL  WRITE  ', 

STYPES 

69 

120 

+ 'OVER  THE  OLD  FILE  . ' 

STYPES 

70 

12  1 

250 

PRINT* 

STYPES 

71 

1 22 

PRINT*, 'YOU  MAY  EITHER  (1)  ABORT  OR  (2)  CONTINUE.' 

STYPES 

72 

123 

PRINT* ,' INDICATE  YOUR  CHOICE  BY  ENTERING  A NUMBER.' 

STYPES 

73 

124 

REWIND  1 

STYPES 

74 

125 

READd, *,END  = 250  ) ANSWER 

STYPES 

75 

126 

PRINT* 

STYPES 

76 

127 

PRINT*, 'PROGRAM  HAS  BEEN  ABORTED,  PER  YOUR  REQUEST' 

STYPES 

77 

128 

PRINT* 

STYPES 

71 

163 
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129 

IF  ( ANSWER  EQ.  1 ) THEN 

STYF  ES 

1 30 

STOP 

STYPES 

13  1 

ELSE  IF  ( ANSWER  .EQ.  2 ) THEN 

STYPES 

1 32 

255 

CONTINUE 

STYPES 

133 

ELSE 

STYFES 

134 

GOTO  250 

STYPES 

135 

END  IF 

STYPES 

136 

ELSE  IF  ( lERR  EQ.  2 ) THEN 

STYPES 

137 

A 

STYPES 

1 38 

A 

NO  DATA  FILE  EXISTS  FOR  THIS  BUILDING  AND  DATA  ENTRY 

STYPES 

139 

A 

CAN  CONTINUE 

STYPES 

1 40 

A 

STYPES 

14  1 

260 

CONTINUE 

STYFES 

1 42 

ELSE 

STYPES 

14  3 

A 

STYFES 

1 44 

A 

**PERMANENT  FILE  ERROR 

STYPES 

14  5 

A 

STYFES 

146 

PRINT* 

STYPES 

14  7 

PRINT* PROGRAM  ABORTED  !!!’ 

STYPES 

148 

PRINT*,'  SOME  PERMANENT  PILE  ERROR  HAS  OCCURRED' 

STYPES 

14  9 

PRINT*,'  DOUBLE  CHECK  YOUR  BUILDING  IDENTIFICATION  ', 

STYPES 

150 

+ 

•AND  TRY  AGAIN' 

STYPES 

15  1 

STOP 

STYPES 

152 

END  IF 

STYPES 

15  3 

PRINT* 

STYFES 

154 

PRINT*,  ' BEGIN  ENTERING  DATA' 

STYPES 

155 

300 

TTOT  = TTOT  + 1 

STYPES 

156 

IF  ( TTOT  EQ.  1)  THEN 

STYPES 

15  7 

CALL  DATAINI 1 , TTOT) 

STYPES 

1 58 

ELSE 

STYPES 

15  9 

CALL  DATAIN  (0  ,TTOT) 

STYPES 

160 

END  IF 

STYPES 

16  1 

400 

PRINT* 

STYPES 

162 

PRINT*,  'DO  YOU  WANT  TO  ENTER  MORE  DATA?', 

STYPES 

163 

+ 

' ( 1)  YES  C 2 ) NO ' 

STYPES 

164 

PRINT*,  • ENTER  A NUMBEER  !!!' 

STYFES 

165 

REWIND  1 

STYPES 

166 

READd  ,*,END  = 4 0 0 ) ANSWER 

STYPES 

167 

IF  ( (ANSWER  NE.  1)  AND.  (ANSWER  NE.  2)  ) THEN 

STYFES 

168 

GOTO  400 

STYPES 

16  9 

ELSE  IF  ( ANSWER  ,EQ.  1)  THEN 

STYPES 

170 

GOTO  300 

STYPES 

17  1 

ELSE  IF  ( ANSWER  .EQ.  2 ) THEN 

STYFES 

172 

PRINT* 

STYPES 

173 

PRINT*,  'DATA  ENTRY  DISCONTINUED' 

STYPES 

174 

END  IF 

STYPES 

175 

END  IF 

STYPES 

176 

A 

STYPES 

17  7 

AAA 

MANIPULATE  DATA 

STYPES 

178 

CALL  MANIP  (QUIT, ABORT) 

STYPES 

17  9 

A 

STYPES 

180 

AAA 

TERMINATE  PROGRAM,  STORING  DATA  IF  NECESSARY 

STYPES 

18  1 

IF  ( QUIT  ,EQ.  1 ) THEN 

STYPES 

182 

OPEN(UNIT  = 6 , F ILE  = PFN( 1 : GETL EN ( PFN ) ) , FORM= ' FORMATTED ' , 

STYPES 

183 

+ 

ACCESS= ' SEQUENTIAL ' , 5TATUS= 'NEW' ) 

STYPES 

184 

500 

FORMAT  ( IX  , 3 ( IX  , A3 ) , 4(  IX , F8  . 2 ) ) 

STYPES 

185 

DO  6 0 0 N --  l,TTOT 

STYPES 

186 

WRITE  ( 6 ,5  0 0 ) (TYPE (N, Y1 ) , Y 1 = 1 , 3 ) , ( TD IM ( N , Y2 ) , Y2  = l,4) 

STYPES 

187 

600 

CONTINUE 

STYPES 

188 

ENDFILE(6) 

STYPES 

189 

CALL  PF  (' REPLACE ', 0 , PFN( 1 : CETLEN( PFN) ) ) 

STYFES 

WARNING* 

NUMBER 

OF  ARGUMENTS  IN  REFERENCE  TO  _PF  IS  NOT  CONSISTENT 

190 

C LOSE ( 6, STATUS=' DELETE' ) 

STYPES 

191 

PRINT* 

STYPES 

7? 

8D 

3 1 

82 

83 

34 

35 

8 i 

3 7 

8 8 

89 

9 0 

9 1 

9 2 

93 

94 

9 5 

96 

97 

98 

99 

100 

101 

1 02 

103 

1 0 4 

105 

106 

107 

108 

109 

1 10 

1 1 1 

1 12 

113 

1 14 

115 

1 16 

117 

1 18 

119 

1 20 

121 

122 

123 

124 

125 

126 

127 

12  8 

129 

1 30 

131 

1 32 

133 

1 34 

135 

1 36 

137 

138 

139 

140 

141 
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192 

PRINT*, 'DATA  HAS  BEEN  STORED  AND  PROGRAM  TERMINATED' 

STYPES 

142 

193 

END  IF 

STYPES 

1 43 

19  4 

IF(  ABORT  EQ.  1 ) THEN 

STYPES 

144 

195 

PRINT* 

STYPES 

145 

196 

PRINT*,  'PROGRAM  HAS  BEEN  ABORTED' 

STYPES 

146 

197 

PRINT*,'  NO  DATA  HAS  BEEN  STORED  !!!' 

STYPES 

1 47 

198 

END  IF 

STYPES 

148 

199 

STOP 

STYPES 

14? 

200 

END 

STYPES 

150 

-VARIABLE  MAP--(LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


ABORT 

1 077B 

INTEGER 

AFLAC 

2B 

/ INITILN/ 

REAL 

ANSWER 

1 lOOB 

INTEGER 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

FERR 

6 6B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTOT 

67B 

/ INITILN/ 

INTEGER 

lERR 

1 105B 

INTEGER 

LINE 

NONE 

UNUSED/*S* 

INTEGER 

N 

1 102B 

INTEGER 

NROOMS 

1 2 4 4B 

/ROOMN/ 

INTEGER 

OLDFILE 

1 10  IB 

INTEGER 

PFN 

1 1 06B 

CHAR*7 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

QUIT 

1 076E 

INTEGER 

RAREA 

1 245B 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 

ROOM 

06 

/ROOMN/ 

REAL 

676 

TDBTOT 

323B 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

1 40 

TERR 

32  4B 

/TYPEN/ 

INTEGER 

TTOT 

214B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

105 

Y1 

1 103B 

INTEGER 

Y2 

1104B 

INTEGER 

-SYMBOLIC  CONSTANTS--(LO=A) 


-NAME TYPE- VALUE 

FMAX  INTEGER  50 
RMAX  INTEGER  20 
TMAX  INTEGER  35 


-PROCEDURES--(LO=A) 

-NAME TYPE ARCS CLASS -NAME TYPE ARCS CLASS 


DATAIN 

2 

SUBROUTINE 

LTYPE 

ERROR 

1 

SUBROUTINE 

MAN  IP 

GETLEN 

INTEGER 

1 

FUNCTION 

PF 

0 SUBROUTINE 
2 SUBROUTINE 
5 SUBROUTINE 
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-STATEMENT  LABELS- -( LO= A ) 


-LABEL- 

ADDRESS 

--PROPERTIES DEF 

-LABEL 

-ADDRESS 

--PROPERTIES- 

---DEF 

100 

2 IB 

70 

300 

24  6B 

1 55 

200 

47B 

82 

400 

26  0B 

161 

250 

166B 

121 

500 

62  6B 

FORMAT 

1 84 

255 

*NO  REFS* 

132 

600 

INACTIVE 

DO-TERM 

187 

260 

*NO  REFS* 

141 

-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS 

STYPES  14B  0 


-I  IQ  UNITS--(LO=A) 
-NAME---  PROPERTIES- 

TAPEl  FMT/SEQ 
TAPE6  AUX/FMT/SEQ 


-STATISTICS-- 


FROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


11 12B  = 586 

1 76  IB  = 1009 

63000B  = 26112 

0.287  SECONDS 


1 WARNING  ERROR  IN  STYPES 
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1 

2 

3 

4 

5 

6 
7 
S 
9 

10 
1 1 
12 
13 
1 4 

15 
1 6 
17 

16 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


SUBROUTINE  DATAIN  ( I NSERT , L I NE ) STYFES 

**»  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  ***COMR 

INTEGER  RMAX  COMR 

PARAMETER  <RMAX  = 20)  COMR 

COMMON  /ROOMN/  ROOMIRMAX  + 6,  RMAX  + 6),  NROOMS,  RAREA(RMAX)  COMR 

INTEGER  NROOMS  COMR 

REAL  ROOM  COMR 

*******«««**«««i**«*«Mt**it*****it«***)t*******«******«««*ii[««*«*«A*«it*x**«**  * COMR 

*»*  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  ***COMT 


*****ltt***t*tt*t****t1iltt**t***t**1Hi**1i**1i*1i***t**'k*t1i*k*1i****1iii***t***»*  COMT 


INTEGER  TMAX 
PARAMETER  (TMAX=35) 

COMMON  /TYPEN/TDIM(TMAX, 4) , TTOT , TDB2 (TMAX , 2 ) ,TDBTOT,TERR 
COMMON  /TYPEC/TYPE(TMAX , 3) ,TDB1 (TMAX) 

INTEGER  TTOT, TDBTOT, TERR 
REAL  TDIM,TDB2 
CHARACTER  * 3 TYPE.TDBl 


DESCRIPTION  OF  ARRAYS 

ID 

MATERIAL 

FRAME  MATERIAL 

TYPE(X, 1) 
A3 

TYPE(X,  2) 
A3 

TYPE(X, 3) 
A3 

HEIGHT 

WIDTH 

LAYER 

THICKNESS 

DISTANCE 
ABOVE  FLOOR 

TDIM( X, 1 ) 
F8  . 2 

TDIM( X, 2) 
F6  .2 

TDIM( X, 3) 
F8  .2 

TDIM( X, 4) 
F8  . 2 

ID 

ATTENUATION 

AREA 

TDBl (X) 
A3 

TDB2 (X , 1 ) 
E9  . 3 

TDB2 (X  , 2 ) 
E9  . 3 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 


* t * k * t * * t * * k * * t * * * * * * t * * * * 1 1 k t * * * * t * k * 1 1 1 * * * 1 1 * * * * * k t k t * » * kk  * * t * t * t * t * * QO'nj 


kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk * CQNT 


INTEGER  ANSWER, LOK, DOK, NOK ,GETLEN,VAL,  INSERT , L I NE , V 
REAL  H,W,T, ABOVE 
CHARACTER  *3  D IR , ID ,MAT , FHAT 
99  IF  ( INSERT  . EQ . 1 ) THEN 
ANSWER  = 1 
INSERT  = 1 
ELSE 

100  PRINT* 

PRINT*,  'IS  THIS  THE  FIRST  LAYER  OF  A DOOR  OR  WINDOW?', 
+ ' (1)  YES  (2)  NO' 

PRINT*,  ' ENTER  "0"  TO  ESCAPE  "DATA  ENTRY"  MODE' 

PRINT*,  ' ENTER  A NUMBER!!' 

REWIND  1 

READ(1,*,END=100)  ANSWER 
END  IF 


* 


IF  (ANSWER  ,EQ.  0)  THEN 
TTOT  = TTOT  - 1 
PRINT* 

PRINT*,  'DATA  ENTRY  MODE  ABORTED' 
END  IF 


IF  ((ANSWER  .NE.  2) 


STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 

STYPES 


151 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

154 

155 
1 56 
157 
1 58 
159 
1 60 
1 6 1 
1 62 
163 
1 64 

165 

166 
167 
166 
U9 
1 70 
171 
1 72 
173 
1 74 
175 
1 76 


167 
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6 j 

.AND.  (ANSUER  .NE.  1) 

STYFE3 

177 

66 

+ 

AND  (ANSWER  .NE,  0))  THEN 

STY FES 

i 7 0 

67 

PRINT* 

STYPES 

179 

68 

PRINT*,  ' INCORRECT  NUMBER !! ' 

STYPES 

1 80 

69 

PRINT*,  ' TRY  AGAIN!!  -OR-  ENTER  "0"  TO  ESCAPE  DATA 

ENTRY  MODE ' STYPES 

1 8 1 

70 

GOTO  99 

STYPES 

182 

71 

END  IF 

STYPES 

183 

72 

it 

STYPES 

1 8 4 

73 

A 

STYPES 

185 

74 

IF  ( ANSUER  .EQ.  1 ) THEN 

STYPES 

1 86 

75 

3 00 

PRINT* 

STYPES 

187 

76 

PRINT*,  'ENTER  "ID''  (EG.  ' ' UA ' ' OR  ''DE'')' 

STYPES 

1 8 5 

77 

REWIND  1 

STYFES 

189 

78 

READ( 1 , * ,END=300)  ID 

STYPES 

i 90 

79 

IF  ( ( ( ICHAR( ID( 1 ; 1 ) ) . EQ . 55) 

STYPES 

1 9 1 

80 

+ 

OR.  ( ICHAR< ID( 1 : 1 ) ) .EQ.  36)) 

STYPES 

1 92 

81 

+ 

AND.  ( ICHAR(ID(2 ; 2) ) . GE . 33) 

STYFES 

193 

82 

+ 

AND.  ( ICHARC ID (2 : 2 ) ) .LE.  58) 

STYPES 

1 94 

83 

+ 

AND.  (GETLEN(ID)  . EQ , 2))  THEN 

STYPES 

195 

84 

TYPE(EINE,1)  = ID 

STYPES 

1 96 

85 

ELSE 

STYPES 

197 

86 

PRINT* 

STYPES 

1 98 

87 

PRINT*,  'INCORRECT  ENTRY.  TRY  AGAIN!!' 

STYFES 

199 

88 

GOTO  300 

STYPES 

2 00 

89 

END  IF 

STYPES 

20  1 

90 

* 

STYPES 

2 02 

91 

440 

PRINT* 

STYPES 

203 

92 

PRINT*,  'ENTER  HEIGHT,  METERS' 

STYPES 

204 

93 

REWIND  1 

STYPES 

205 

94 

READ( 1 , * ,END=440)  TDIM(LINE,1) 

STYPES 

2 06 

95 

t 

STYFES 

20  7 

96 

460 

PRINT* 

STYPES 

208 

97 

PRINT*,  'ENTER  WIDTH,  METERS' 

STYPES 

209 

98 

REWIND  1 

STYPES 

2 10 

99 

READ( 1 , * , END=460 ) TDIM(LINE,2) 

STYPES 

2 1 1 

100 

* 

STYPES 

2 12 

10  1 

470 

PRINT* 

STYPES 

213 

102 

PRINT*,  'ENTER  DISTANCE  ABOVE  FLOOR,  METERS' 

STYPES 

2 14 

103 

REWIND  1 

STYPES 

215 

104 

READ( 1 , * ,END=470)  TDIM(LINE,4) 

STYPES 

2 16 

105 

* 

STYPES 

217 

106 

480 

PRINT* 

STYPES 

2 1 8 

107 

PRINT*,  'ENTER  THICKNESS  OF  LAYER,  CENTIMETERS' 

STYPES 

219 

108 

REWIND  1 

STYPES 

220 

109 

READ ( 1 , * , END=480 ) TDIM(LINE,3) 

STYPES 

221 

1 10 

* 

STYPES 

222 

11  1 

500 

PRINT* 

STYPES 

223 

112 

PRINT*,  'ENTER  "MATERIAL  ID  OF  LAYER"  (E.G.  ''MOl'') 

' STYPES 

224 

113 

REWIND  1 

STYPES 

225 

114 

READ( 1 , * ,END=500)  MAT 

STYPES 

226 

115 

IF  ( ( GETLEN(MAT) . EQ  3 ) 

STYPES 

227 

1 16 

+ 

.AND.  (MAT(1:1)  . EQ . 'M') 

STYPES 

228 

117 

+ 

.AND.  ( ICHAR(MAT( 2 : 2) ) . GE  16) 

STYPES 

2 29 

1 18 

+ 

.AND.  ( ICHAR(MAT( 2 : 2 ) ) . LE . 25) 

STYPES 

2:-o 

1 1 9 

+ 

.AND.  ( ICHAR(MAT( 3 ; 3 ) ) . GE . 16) 

STYPES 

23  1 

120 

+ 

AND.  ( ICHAR(MAT(3 ; 3 ) ) .LE.  25))  THEN 

STYPES 

2 32 

12  1 

TYPE(LINE,2)  = MAT 

STYPES 

233 

122 

ELSE 

STYPES 

2 34 

123 

PRINT* 

STYPES 

235 

124 

PRINT*,  'INCORRECT  ENTRY!!  TRY  AGAIN' 

STYPES 

2 36 

125 

GOTO  500 

STYPES 

237 

126 

END  IF 

STYPES 

2 38 

127 

* 

STYPES 

239 

128 

5 10 

PRINT* 

STYPES 

240 
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1 29 

PRINT*,  'ENTER  "MATERIAL  ID  OF 

FRAME"  (E.G.  ' ' MO  1'  ' ) 

■ STYPES 

241 

130 

REWIND  1 

STYPES 

2 42 

13  1 

READ( 1 , * , END=51 0)  FMAT 

STYPES 

243 

132 

IF  ( (GETLEN(FMAT) . EQ.  3) 

STYPES 

2 44 

133 

♦ 

AND.  (FMAT(1;1)  .EQ.  'M') 

STYPES 

245 

1 34 

•f 

AND.  ( ICHAR(FMAT(2 : 2) ) .GE 

. 16 ) 

STYPES 

2 46 

135 

♦ 

AND.  ( ICHAR(FMAT(2 ; 2)  ) . LE 

. 25  ) 

STYPES 

247 

1 36 

4> 

AND.  ( ICHAR(FMAT(3 : 3) ) .GE 

. 16 ) 

STYPES 

2 48 

137 

•f 

AND  ( ICHAR(FMAT< 3 : 3) ) . LE 

. 25))  THEN 

STYPES 

249 

1 38 

TYPE(LINE,3)  = FMAT 

STYPES 

250 

139 

ELSE 

STYPES 

251 

140 

PRINT* 

STYPES 

2 52 

14  1 

PRINT*,  'INCORRECT  ENTRY!! 

TRY  AGAIN' 

STYPES 

253 

142 

GOTO  510 

STYPES 

2 54 

143 

END  IF 

STYPES 

255 

144 

END  IF 

STYPES 

256 

145 

t 

STYPES 

257 

1 46 

t 

STYPES 

2 58 

147 

t 

STYPES 

259 

148 

IF  (ANSWER  .EQ.2)  THEN 

STYPES 

260 

14  9 

580 

PRINT* 

STYPES 

261 

ISO 

PRINT*,  'ENTER  THICKNESS  OF  LAYER,  CENTIMETERS' 

STYPES 

2 62 

15  1 

REWIND  1 

STYPES 

263 

152 

READ( 1 , * ,END=580)  TDIM(LINE,3) 

STYPES 

264 

15  3 

* 

STYPES 

265 

154 

600 

PRINT* 

STYPES 

2 66 

155 

PRINT*,  'ENTER  "MATERIAL  ID  OF 

LAYER"  (E.G.  ' ' MO  1'  ' ) 

' STYPES 

267 

156 

REWIND  1 

STYPES 

268 

157 

READ( 1 , * , END  = 6 0 0 ) MAT 

STYPES 

269 

158 

IF  ( (GETLEN(MAT)  EQ.  3) 

STYPES 

2 70 

159 

-f 

AND.  (MAT( 1:1)  EQ.  'M'  ) 

STYPES 

27  1 

160 

+ 

.AND.  ( ICHAR(MAT(2 : 2 ) ) . GE . 

16  ) 

STYPES 

2 72 

16  1 

+ 

AND.  ( ICHAR(MAT( 2 : 2) ) . LE . 

25  ) 

STYPES 

273 

162 

+ 

.AND.  ( ICHAR(MAT(3 : 3 ) ) . GE . 

16) 

STYPES 

2 74 

163 

+ 

AND.  ( ICHAR(MAT(3 ; 3) ) . LE . 

25))  THEN 

STYPES 

275 

164 

TYPE (LINE ,2)  = MAT 

STYPES 

2 76 

165 

ELSE 

STYPES 

277 

166 

PRINT* 

STYPES 

2 78 

167 

PRINT*,  'INCORRECT  ENTRY!! 

TRY  AGAIN' 

STYPES 

279 

168 

GOTO  600 

STYPES 

2 80 

169 

END  IF 

STYPES 

281 

170 

TYPE(LINE,3)  = TYPE ( L INE - 1 , 3 ) 

STYPES 

282 

17  1 

TYPE(LINE,1)  = TYPE(LINE-1 , 1) 

STYPES 

283 

172 

TDIM(LINE,n  = TDIM(LINE-1  , 1 ) 

STYPES 

2 84 

173 

TDIM(LINE,2)  = TD IM ( LI NE - 1 , 2 ) 

STYPES 

285 

174 

TDIK(LINE,4)  = TD IM ( L I NE - 1 , 4 ) 

STYPES 

2 86 

175 

END  IF 

STYPES 

287 

176 

RETURN 

STYPES 

2 88 

177 

END 

STYPES 

289 

--VARIABLE 

MAP--(LOrA) 

-NAME- --ADDRESS- -BLOCK- 

-PROPERTIES 

TYPE 

---SIZE 

ABOVE 

NONE 

UNUSED/*S* 

REAL 

ANSWER 

1 0 7 6B 

INTEGER 

DIR 

NONE 

UNUSED/*S* 

CHAR*3 

DOK 

NONE 

UNUSED/*S* 

INTEGER 

FMAT 

1 lOlB 

CHAR*3 

H 

NONE 

UNUSED/ *S* 

REAL 

ID 

1 07  7B 

CHAR*3 

INSERT 

1 DUMMY-ARG 

INTEGER 

LINE 

2 DUMMY-ARG 

INTEGER 

LOK 

NONE 

UNUSED/ *S* 

INTEGER 
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74/175 

OPT  = 0 

MAT 

1 1 OOB 

CHAR*3 

NOK 

NONE 

UNUSED/ *S* 

INTEGER 

NROOMS 

1244B 

/ROOMN/ 

INTEGER 

RAREA 

1245B 

/ROOMN/ 

REAL 

20 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

T 

NONE 

UNUSED/*S* 

REAL 

TDBTOT 

32  3B 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR* 3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

1 40 

TERR 

324B 

/TYPEN/ 

INTEGER 

TTOT 

21  4B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

105 

V 

NONE 

UNUSED/ *S* 

INTEGER 

VAL 

NONE 

UNUSED/ *S* 

INTEGER 

U 

NONE 

UNUSED/ *S» 

REAL 

-SYMBOLIC  C0NSTANT5--(L0=A) 


-NAME 

-TYPE 

VALUE 

RMAX 

INTEGER 

20 

TMAX 

INTEGER 

35 

-PROCEDURES--(LO=A) 

-NAME--- 

---TYPE- 

--ARGS--- 

---CLASS 

GETLEN 

INTEGER 

1 

FUNCTION 

ICHAR 

INTEGER 

1 

INTRINSIC 

-STATEMENT  LABELS--! L0=A) 


-LABEL- 

ADDRESS--- 

---PROPERTIES DEF 

-LABEL 

-ADDRESS--- 

---PROPERTIES DEF 

99 

7B 

45 

480 

21  3B 

1 06 

100 

16B 

49 

500 

22  7B 

1 1 1 

300 

70B 

75 

5 10 

31  IB 

1 28 

440 

147B 

91 

580 

37  7B 

149 

460 

163B 

96 

6 00 

41  3B 

1 54 

470 

177B 

101 

-ENTRY  POINTS--(LO=A) 
-NAME ---ADDRESS- -ARCS- -- 

DATAIN  5B  2 


-I/O  UNITS--(LO=A) 
-NAME---  PROPERTIES 

TAPEl  FMT/SEQ 


-STATISTICS-- 

PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


1104B  = 580 

U70B  = 952 

63000B  = 26112 

0.328  SECONDS 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 
29 


SUBROUTINE  MANIP  (QUIT, ABORT) 

ttt»tttt**ttt*ii**tt*t**»*tt***ttttii**t*****t**t*t***t*t**t*t**t*t**** 

*•»  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS 

»t*»*t*t*tt*t*ttt**tttt*t*tttttt*t*t*tt*tt*tt*t*tt*t*tt****tt***tt*t*t 

INTEGER  TMAX 
PARAMETER  (TMAX=35) 

COMMON  /TYPEN/TDIM(TMAX , 4) ,TT0T,TDB2 (TMAX , 2 ) ,TDBTOT,TERR 
COMMON  /TYPEC/TYPE(TMAX,3) ,TDB1(TMAX) 

INTEGER  TTOT,TDBTOT,TERR 
REAL  TDIM,TDB2 
CHARACTER  * 3 TYPE,TDB1 


DESCRIPTION  OF  ARRAYS 

ID 

MATERIAL 

FRAME  MATERIAL 

TYPE(X,  1) 
A3 

TYPE(X, 2) 
A3 

TYPE(X, 3) 
A3 

HEIGHT 

WIDTH 

LAYER 

THICKNESS 

DISTANCE 
ABOVE  FLOOR 

TD  I M ( X , 1 ) 
F8  . 2 

TDIM( X, 2) 
F8  .2 

TDIM( X, 3) 
FB  .2 

TDIM( X, 4) 
F8  . 2 

ID 

ATTENUATION 

AREA 

TDBKX) 

A3 

TDB2 (X, 1 ) 
E9  . 3 

TDB2(X,2) 
E9  . 3 

3TYPES 

***COMT 

**»COMT 

***COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 


290 

1 

2 

3 

4 

e 

6 

7 

8 
9 

10 
1 1 
12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 


30 

2? 

31 

t*AtAtAAt*ftft*A**A*t*A**A***t****A**tA*A]kA*AA*****ltAAiltt**1t*A***tA***«A**  * COMT 

30 

32 

INTEGER 

ABORT, ANSWER, DOK , FL AG  1 , LOK ,N , NOK , OK , OK  1 ,OK2 , QUIT, INSERT 

STYPES 

2 92 

33 

INTEGER 

TEMP ,V, X,Y, COMMAND 

STYPES 

293 

34 

* 

STYPES 

294 

35 

10 

FLAGl  = 

0 

STYPES 

295 

36 

PRINT* 

STYPES 

296 

37 

PRINT* , 

'CHOOSE ' 

STYPES 

297 

38 

PRINT* , 

' (I)  DISPLAY  LINE  OF  DATA  (4)  DISPLAY  ALL  LINES' 

STYPES 

2 98 

39 

PRINT* , 

' (2)  INSERT  LINE  INTO  FILE  (5)  APPEND  LINES  OF  DATA' 

STYPES 

299 

40 

PRINT* , 

' (3)  DELETE  LINE  (6)  STORE  DATA  AND  EXIT  ', 

STYPES 

300 

41 

+ 

' PROGRAM' 

STYPES 

301 

42 

PRINT* , 

' (7)  EXIT  PROGRAM  WITHOUT  ' 

STYPES 

302 

43 

+ 

'STORING  DATA' 

STYPES 

303 

44 

PRINT* , 

' ENTER  A NUMBER  ! ! ! ' 

STYPES 

304 

45 

PRINT* 

STYPES 

305 

46 

REWIND 

1 

STYPES 

3 06 

47 

READ( 1 , 

*,END=10)  COMMAND 

STYPES 

307 

48 

* 

STYPES 

308 

49 

* 

STYPES 

309 

50 

tut 

DISPLAY  LINE  *** 

STYPES 

3 10 

51 

t 

STYPES 

311 

52 

IF  ( COMMAND  . EQ . 1 ) THEN 

STYPES 

3 12 

53 

t 

STYPES 

3 1 3 

54 

tut 

INDICATE 

EMPTY  DATA  FILE 

STYPES 

3 1 4 

55 

IF  ( 

TTOT  .EQ.  0 ) THEN 

STYPES 

315 

56 

PRINT* 

STYPES 

3 1 6 

57 

PRINT*,  'DATA  FILE  IS  EMPTY  !!!' 

STYPES 

317 

58 

t 

STYPES 

3 18 

59 

t** 

ENTER  NUMBER  OF  LINE  TO  BE  DISPLAYED 

STYPES 

3 1 9 

60 

ELSE 

STYPES 

320 

61 

100 

PRINT* 

STYPES 

32  1 

62 

PRINT*,  'SPECIFY  THE  NUMBER  OF  THE  LINE  TO  BE  DISPLAYED' 

STYPES 

322 

63 

PRINT*,  ' ( ENTER  "0"  TO  ESCAPE  DISPLAY  MODE  )' 

STYPES 

323 

64 

REWIND  1 

STYPES 

324 
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65 

READ( 1 , »,END=100)  N 

STYPES 

325 

66 

t 

STYPES 

326 

67 

tt  n 

CHECK  VALIDITY  OF  LINE  NUMBER 

STYPES 

327 

68 

IF  ( (N  GT.  TTOT)  OR.  (N  .LT 

. 0)  ) THEN 

STYPES 

328 

69 

PRINT* 

STYPES 

329 

70 

PRINT*,  ' INCORRECT  NUMBER  !! 

! ! ! ! TRY  AGAIN 

! ! ! ' 

STYPES 

3 :-3 

71 

PRINT*,  • -OR-  ENTER  "0"  TO  ESCAPE 

ID 

1 

STYPES 

331 

72 

+ '"DISPLAY"  MODE' 

STYPES 

332 

73 

GOTO  100 

STYPES 

333 

74 

t 

STYPES 

334 

75 

t** 

ABORT  'DISPLAY'  MODE 

STYPES 

335 

76 

ELSE  IF  ( N .EQ.  0 ) THEN 

STYPES 

336 

77 

PRINT* 

STYPES 

337 

78 

PRINT*,  ' "DISPLAY"  MODE 

ABORTED  ! ! ! ' 

STYPES 

3 38 

79 

t 

STYPES 

339 

80 

ttt 

DISPLAY  LINE  OF  DATA 

STYPES 

3 40 

81 

ELSE  IF  ( (N  .GT.  0)  .AND.  <N 

,LE.  TTOT)  ) THEN 

STYPES 

341 

82 

PRINT* 

STYPES 

342 

83 

CALL  DISPLAY!  N,  COMMAND) 

STYPES 

343 

84 

t 

STYPES 

344 

85 

END  IF 

STYPES 

345 

86 

END  IF 

STYPES 

346 

87 

END  IF 

STYPES 

347 

88 

t 

STYPES 

3 48 

89 

t 

STYPES 

349 

90 

* * * 

INSERT  LINE  *** 

STYPES 

3 50 

91 

% 

STYPES 

351 

92 

IF  ( COMMAND  .EQ.  2 ) THEN 

STYPES 

352 

93 

t 

STYPES 

353 

94 

* * * 

INDICATE  EMPTY  DATA  FILE 

STYPES 

354 

95 

IF  ( TTOT  .EQ.  0 ) THEN 

STYPES 

355 

96 

PRINT* 

STYPES 

356 

97 

PRINT*,  'DATA  FILE  IS  EMPTY  !! 

! ' 

STYPES 

357 

98 

t 

STYPES 

358 

99 

t * A 

REQUEST  NUMBER  OF  LINE  BEFORE  WHICH 

INSERTION  IS  TO  EE 

; MADE 

STYPES 

359 

1 00 

ELSE 

STYPES 

360 

10  1 

200 

PRINT* 

STYPES 

36  1 

102 

PRINT*,  'SPECIFY  NUMBER  OF  LINE  BEFORE  WHICH  A NEW 

LINE  IS  ' 

, STYPES 

362 

103 

+ 'TO  BE  INSERTED' 

STYPES 

363 

104 

PRINT*,  ' ( ENTER  "0"  TO  ESCAPE  “INSERTION" 

MODE  ) ' 

STYPES 

364 

105 

REWIND  1 

STYPES 

365 

106 

READd  ,*,END  = 2 0 0 ) N 

STYPES 

3 66 

107 

A 

STYPES 

367 

108 

AAA 

CHECK  FOR  VALID  LINE  NUMBER 

STYPES 

368 

109 

IF  ( ( N .LT.  0 ) .OR.  ( N .GT 

. TTOT  ) ) THEN 

STYPES 

369 

no 

PRINT* 

STYPES 

3 70 

11  1 

PRINT*,  ' INCORRECT  NUMBER  !! 

1 ' 

STYPES 

371 

112 

PRINT*,  ' TRY  AGAIN  ! ! ! 

-OR-  ENTER  "0" 

TO 

ESCAPE' , 

STYPES 

372 

113 

+ '"INSERTION"  MODE' 

STYPES 

373 

114 

GOTO  200 

STYPES 

374 

115 

A 

STYPES 

375 

1 16 

AAA 

ABORT  INSERTION  MODE 

STYPES 

376 

117 

ELSE  IF  ( N EQ.  0 ) THEN 

STYPES 

377 

118 

PRINT* 

STYPES 

3 78 

119 

PRINT*,  ' "INSERTION" 

MODE  ABORTED' 

STYPES 

379 

1 20 

A 

STYPES 

380 

121 

AAA 

MAKE  ROOM  FOR  NEW  LINE  OF  DATA 

STYPES 

381 

1 22 

ELSE  IF  ( <N  GT.  0)  AND.  (N 

.LE.  TTOT)  ) THEN 

STYPES 

382 

123 

DO  230  X = TTOT, N, -1 

STYPES 

383 

124 

DO  210  Y = 1,3 

STYPES 

384 

125 

TYPE(X+1,Y)  = TYPE(X,Y) 

STYPES 

385 

126 

210 

CONTINUE 

STYPES 

386 

127 

DO  220  Y = 1,4 

STYPES 

387 

128 

TDIM(X+1 , Y)  = TDIMIX ,Y) 

STYPES 

388 
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12V 

220 

CONTINUE 

STYFES 

389 

1 30 

230 

CONTINUE 

5TYPES 

3 90 

13  1 

• 

STYPES 

391 

1 32 

t « t 

ENTER  DATA  FOR  NEW  LINE 

STYPES 

3 92 

133 

TTOT  = TTOT  + 1 

STYPES 

393 

134 

CALL  DATAIN  (1,N) 

STYPES 

394 

135 

STYPES 

395 

136 

tut 

INITIALIZE  FLAGS 

STYPES 

3 96 

137 

OKI  = 0 

STYPES 

397 

138 

OK2  = 0 

STYPES 

3 98 

139 

OK  = 0 

STYPES 

399 

1 40 

t 

STYPES 

400 

14  1 

* ft  t 

TEST  VALIDITY  OF  DATA 

STYPES 

401 

142 

ft 

STYPES 

4 02 

143 

»**TEST  IF 

NEW  LAYER  BELONGS  TO  THE  NEXT  TYPE 

STYPES 

403 

144 

IF  ( ( TYPE(N,1)  .EQ.  TYPE(N+1,1)  ) 

STYPES 

4 04 

145 

+ 

.AND.  ( TYPE(N,3)  EQ.  TYPE(N+1,3)  ) ) THEN 

STYPES 

405 

146 

IF  ( ( TDIM(N,1)  .EQ.  TDIM(N+1,1)  ) 

STYPES 

4 06 

147 

+ 

AND.  ( TDIM(N,2)  .EQ.  TDIM<N+1,2)  ) 

STYPES 

407 

148 

+ 

.AND.  ( TDIM(N,4)  .EQ.  TDIM(N+1,4)  ) ) THEN 

STYPES 

408 

149 

OKI  = 1 

STYPES 

409 

ISO 

END  IF 

STYPES 

4 10 

15  1 

END  IF 

STYPES 

4 1 1 

1 52 

ft 

STYPES 

4 12 

153 

ft  ft  ft 

TEST  IF 

NEW  LAYER  BELONGS  TO  PREVIOUS  TYPE 

STYPES 

413 

154 

IF  ( N GT.  1 ) THEN 

STYPES 

4 14 

155 

IF  ( ( TYPE(N,1)  .EQ.  TYPE(N-1,1)  ) 

STYPES 

4 1 5 

156 

+ 

AND.  ( TYPE(N,3)  .EQ.  TYPE(N-1,3)  > ) THEN 

STYPES 

4 16 

157 

IF  ( ( TDIK(N,1>  .EQ.  TDIM(N-1,1)  ) 

STYPES 

417 

158 

+ 

AND.  ( TDIM(N,2)  EQ.  TDIM(N-1,2)  ) 

STYPES 

4 18 

159 

+ 

.AND.  ( TDIM(N,4)  EQ.  TDIM(N-1,4)  ) ) THEN 

STYPES 

4 1 9 

1 60 

OK2  = 1 

STYPES 

420 

16  1 

END  IF 

STYPES 

421 

162 

END  IF 

STYPES 

4 22 

163 

END  IF 

STYPES 

423 

164 

ft 

STYPES 

4 24 

165 

IF  ( ( OKI  .EQ.  1 ) OR.  ( OK2  . EQ . 1 ) ) THEN 

STYPES 

425 

166 

OK  = 1 

STYPES 

426 

167 

END  IF 

STYPES 

427 

168 

ft 

STYPES 

426 

169 

IF  ( OK  EQ.  1 ) THEN 

STYPES 

429 

170 

PRINT* 

STYPES 

4 30 

17  1 

PRINT*,  ‘THE  FOLLOWING  LINE  HAS  BEEN  ADDED  AS  LINE  ' 

/ N 

STYPES 

431 

172 

CALL  DISPLAY!  N,  COMMAND) 

STYPES 

4 32 

173 

ft 

STYPES 

433 

174 

ft  ft* 

REJECT 

DATA  IF  DATA  DOESN'T  MATCH  PREVIOUS  OR  NEXT  LAYER 

STYPES 

4 34 

175 

ELSE  IF  ( OK  EQ.  0 ) THEN 

STYPES 

435 

176 

PRINT* 

STYPES 

4 36 

177 

PRINT*,  ‘YOUR  DATA  WAS  NOT  ACCEPTED  !!!' 

STYPES 

437 

178 

PRINT*,  ‘YOUR  DATA  MUST  REPRESENT  A LAYER  ', 

STYPES 

4 38 

179 

-f 

‘IN  AN  EXISTING  DOOR  OR  WINDOW' 

STYPES 

439 

180 

PRINT*,  ' I.E.  THE  ID,  FRAME  MATERIAL,  HEIGHT,  ', 

STYPES 

4 40 

18  1 

+ 

'WIDTH,  AND  DISTANCE  ABOVE  FLOOR' 

STYPES 

44  1 

182 

PRINT*,  ' PARAMETERS  MUST  MATCH  THE  DOOR  OR  ' 

, 

STYPES 

4 42 

183 

+ 

'WINDOW  JUST  BEFORE' 

STYPES 

443 

184 

PRINT*,  ' OR  JUST  AFTER  YOUR  SPECIFIED  INSERTION 

' , STYPES 

4 44 

185 

+ 

' POINT' 

STYPES 

445 

186 

PRINT* 

STYPES 

4 46 

187 

PRINT*,  'THE  FOLLOWING  DISPLAYS' 

STYPES 

4 47 

188 

IF  ( N GT.  1 ) PRINT*, 'THE  LINE  BEFORE  YOUR  LINE,' 

STYPES 

4 48 

189 

PRINT*,  'YOUR  LINE,  AND  THE  LINE  AFTER' 

STYPES 

449 

190 

PRINT* 

STYPES 

4 50 

19  1 

ft 

STYPES 

45  1 

192 

ft  ft* 

DISPLAY 

LINES  OF  DATA 

STYPES 

452 

173 
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193 

IF  ( N GT.  1 ) CALL  DISPLAY 

! N- 

1, 

COMMAND  ) 

STYPES 

453 

194 

CALL  DISPLAY!  N,  COMMAND) 

STYPES 

454 

195 

CALL  DISPLAY  ( N+ 1 , COMMAND) 

STYPES 

455 

196 

A 

STYPES 

456 

197 

* ** 

REMOVE  THE  LINE  OF  INCORRECTLY  ENTERED 

DATA 

STYPES 

457 

198 

DO  270  X = N.TTOT 

STYPES 

458 

199 

DO  25  0 Y = 1 , 3 

STYPES 

459 

200 

TYPE  (X , Y)  = TYPE(X  + 1 ,Y) 

STYPES 

4 60 

20  1 

250 

CONTINUE 

STYPES 

46  1 

202 

DO  2 6 0 y = 1 ,4 

STYPES 

462 

20  3 

TDIM(X, Y)  = TDIM! X+1,Y) 

STYPES 

463 

204 

260 

CONTINUE 

STYPES 

4 64 

205 

270 

CONTINUE 

STYPES 

465 

206 

TTOT  = TTOT  - 1 

STYPES 

4 66 

207 

END  IF 

STYPES 

467 

208 

END  IF 

STYPES 

4 68 

20  9 

END  IF 

STYPES 

469 

2 10 

END  IF 

STYPES 

4 70 

21  1 

t 

STYPES 

471 

2 12 

t 

STYPES 

472 

213 

A A * 

DELETE  LINE  *** 

STYPES 

473 

2 14 

A 

STYPES 

4 74 

215 

IF  ( COMMAND  .EQ.  3 ) THEN 

STYPES 

475 

2 16 

A 

STYPES 

4 76 

217 

AAA 

INDICATE  EMPTY  DATA  FILE 

STYPES 

477 

2 18 

IF  ( TTOT  EQ.  0 ) THEN 

STYPES 

4 78 

219 

PRINT* 

STYPES 

479 

220 

PRINT*,  'DATA  FILE  IS  EMPTY  '!!' 

STYPES 

480 

22  1 

A 

STYPES 

48  1 

222 

A AA 

READ  NUMBER  OF  LINE  TO  BE  DELETED 

STYPES 

482 

223 

ELSE 

STYPES 

483 

224 

300 

PRINT* 

STYPES 

4 84 

225 

PRINT*,  'SPECIFY  THE  NUMBER  OF  THE  LINE 

TO 

BE 

DELETED' 

STYPES 

485 

226 

PRINT*,  ' (ENTER  "0"  TO  ESCAPE 

DELETION 

MODE)  ' 

STYPES 

486 

227 

REWIND  1 

STYPES 

487 

2 28 

READ( 1 , * ,END=300)  N 

STYPES 

4 88 

229 

A 

STYPES 

489 

230 

AAA 

CHECK  VALIDITY  OF  LINE  NUMBER 

. STYPES 

4 90 

23  1 

IF  ( (N  GT.  TTOT  ) .OR.  ( N .LT. 

0 ) 

) 

THEN 

STYPES 

491 

232 

PRINT* 

STYPES 

4 92 

233 

PRINT*,  ' INCORRECT  NUMBER  !!!' 

STYPES 

493 

234 

PRINT*,  ' TRY  AGAIN  ! ! ! -OR 

- ENTER 

"0" 

TO  ESCAPE  ID ' , 

STYPES 

494 

235 

+ '"DELETE"  MODE' 

STYPES 

495 

236 

GOTO  300 

STYPES 

4 96 

237 

A 

STYPES 

497 

238 

AAA 

ABORT  'DELETE'  MODE 

STYPES 

4 9 8 

239 

ELSE  IF  ( N EQ.  0 ) THEN 

STYPES 

499 

240 

PRINT*,  ' "DELETE"  MODE  ABORTED' 

STYPES 

5 00 

24  1 

A 

STYPES 

501 

242 

AAA 

DOUBLE  CHECK  CHOICE  OF  LINE  TO  BE  DELETED 

STYPES 

5 02 

243 

ELSE  IF  ((  N GT.  0 ) AND.  ( N . 

LE. 

TTOT 

) ) 

THEN 

STYPES 

503 

244 

PRINT* 

STYPES 

5 04 

245 

PRINT* , 'DOUBLE  CHECK  ! ! ! ' 

STYPES 

505 

246 

PRINT*,  ' DO  YOU  WANT  TO  DELETE 

THE 

FOLLOWING  LINE? ; ' 

STYPES 

506 

247 

CALL  DISPLAY!  N,  COMMAND) 

STYPES 

507 

248 

305 

PRINT*,  ' ENTER  !1)  YES  OR 

!2) 

NO  ' 

STYPES 

508 

249 

REWIND  1 

STYPES 

509 

250 

READ! 1 , * ,END=305)  ANSWER 

STYPES 

5 10 

25  1 

A 

STYPES 

511 

252 

AAA 

DELETE  LINE 

STYPES 

5 12 

253 

IF  ! ANSWER  . EQ . 1 ) THEN 

STYPES 

5 1 3 

254 

DO  330  X = N,  TTOT  - 1 

STYPES 

5 14 

255 

DO  310  Y = 1,3 

STYPES 

515 

256 

TYPE  !X  ,¥)  = TYPE!X  + l ,Y) 

STYPES 

5 16 

174 
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257 

3 1 0 

CONTINUE 

STYPES 

5 17 

256 

DO  320  Y = 1,4 

STYPES 

5 IB 

259 

TDIM( X, Y)  = TDIM( X+ 1 , Y) 

STYPES 

5 1 9 

260 

320 

CONTINUE 

STYPES 

5 20 

26  1 

330 

CONTINUE 

STYPES 

52  1 

262 

TTOT  = TTOT  - 1 

STYPES 

5 22 

26  3 

PRINT* 

STYPES 

523 

264 

PRINT*,  'LINE  # ’,N,'  DELETED' 

STYPES 

5 24 

265 

END  IF 

STYPES 

525 

2 66 

t 

STYPES 

526 

26  7 

END  IF 

STYPES 

527 

268 

END  IF 

STYPES 

528 

269 

END  IF 

STYPES 

529 

270 

t 

STYPES 

5 30 

27  1 

t 

•-  STYPES 

53  1 

272 

tut 

DISPLAY  ALL  DATA  *** 

STYPES 

5 32 

273 

* _ . 

STYPES 

533 

274 

IF  ( COMMAND  EQ.  4 ) THEN 

STYPES 

5 34 

275 

« 

STYPES 

535 

276 

* « Ik 

INDICATE  EMPTY  DATA  FILE 

STYPES 

5 36 

277 

IF  ( TTOT  .EQ.  0 ) THEN 

STYPES 

537 

278 

PRINT* 

STYPES 

5 36 

279 

PRINT*,  'DATA  FILE  IS  EMPTY  !!!' 

STYPES 

539 

280 

Ik 

STYPES 

5 40 

28  1 

t * ft 

DISPLAY  DATA 

STYPES 

541 

282 

ELSE 

STYPES 

5 42 

283 

PRINT* 

STYPES 

543 

284 

CALL  DISPLAY!  N,  COMMAND) 

STYPES 

5 44 

285 

Ik 

STYPES 

545 

286 

END  IF 

STYPES 

5 46 

287 

END  IF 

STYPES 

547 

286 

A 

STYPES 

5 48 

289 

» 

- STYPES 

549 

290 

A * * 

ADD  DATA  *** 

STYPES 

550 

29  1 

A 

- STYPES 

551 

292 

IF  ( COMMAND  . EQ . 5 ) THEN 

STYPES 

5 52 

293 

A 

STYPES 

553 

294 

AAA 

ENTER  DATA 

STYPES 

554 

295 

500 

TTOT  = TTOT  + 1 

STYPES 

555 

296 

A 

STYPES 

5 56 

297 

CALL  DATA  IN  (0  , TTOT ) 

STYPES 

557 

298 

510 

PRINT* 

STYPES 

558 

299 

PRINT*,  'DO  YOU  WANT  TO  ENTER  MORE  DATA? 

(1)  YES  (2)  NO' 

STYPES 

559 

300 

PRINT*,  ' ENTER  A NUMBER  !!!' 

STYPES 

5 60 

30  1 

REWIND  1 

STYPES 

561 

302 

READ(1,*,END=510)  ANSWER 

STYPES 

5 62 

303 

A 

STYPES 

563 

304 

AAA 

CHECK  VALIDITY  OF  NUMBER 

STYPES 

5 64 

305 

A 

STYPES 

565 

306 

AAA 

ENTER  MORE  DATA 

STYPES 

5 66 

307 

IF  ( ANSWER  EQ.  1 ) THEN 

STYPES 

567 

308 

GOTO  500 

STYPES 

568 

309 

A 

STYPES 

569 

310 

AAA 

DISCONTINUE  DATA  ENTRY 

STYPES 

" 70 

31  1 

ELSE  IF  ( ANSWER  . EQ . 2 ) THEN 

STYPES 

57  1 

3 12 

PRINT* 

STYPES 

5 72 

313 

PRINT*,  'DATA  ENTRY  DISCONTINUED' 

STYPES 

573 

3 14 

A 

STYPES 

5 74 

315 

AAA 

INVALID  ENTRY 

STYPES 

575 

3 16 

ELSE 

STYPES 

5 76 

317 

GOTO  510 

STYPES 

577 

3 18 

END  IF 

STYPES 

5 71 

31  9 

END  IF 

STYPES 

579 

320 

A 

STYPES 

580 

175 
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321 

322 

323 

* 

* * * 

* 

STORE  DATA  AND  PROGRAM  *** 

ST':(FES 

STYPE3 

53  1 
5 31 
583 

324 

IF  ( COMMAND  ,EQ.  6 ) THEN 

STYPES 

5 84 

325 

600 

PRINT* 

STYPES 

585 

326 

PRINT* , ' DOUBLE  CHECK  IN' 

STYPES 

5 86 

327 

PRINT*,  ' DO  YOU  YOU  WANT  TO  STORE  THIS 

DATA  AND 

END  PROG’ 

STYPES 

587 

328 

PRINT*,  ' NOTE  STORING  THIS  DATA  WILL  WIPE  OUT  ANY 

OLD  FILE 

' STYPES 

5 68 

329 

PRINT*,  ' OF  THE  SAME  NAME  !!!' 

STYPES 

589 

330 

PRINT*,  ' ENTER  A NUMBER:  (1)  YES 

(2>  NO’ 

STYPES 

5 93 

33  1 

REWIND  1 

STYPES 

591 

3 32 

READd  , * , END  = 60  0)  ANSWER 

STYPES 

5 92 

333 

* 

STYPES 

593 

3 34 

AAA 

SET  FLAG  FOR  STORING  DATA  IN  THE  MAIN  PROGRAM 

STYPES 

5 94 

335 

IF  ( ANSWER  EQ.  1 ) THEN 

STYPES 

595 

336 

QUIT  = 1 

STYPES 

5 96 

337 

RETURN 

STYPES 

597 

3 38 

A 

STYPES 

5 96 

339 

AAA 

ABORT  'STORING'  MODE 

STYPES 

599 

340 

ELSE  IF  ( ANSWER  ,EQ.  2 ) THEN 

STYPES 

600 

34  1 

PRINT* 

STYPES 

601 

342 

PRINT*,  ' "STORING"  MODE  DISCONTINUED 

STYPES 

6 02 

343 

A 

STYPES 

603 

344 

AAA 

CHECK  VALIDITY  OF  ANSWER 

STYPES 

6 04 

345 

ELSE  IF  ( ( ANSWER  ,NE.  1 ) AND.  ( ANSWER 

NE.  2 ) 

) THEN 

STYPES 

6 05 

346 

GOTO  600 

STYPES 

t C 6 

34  7 

A 

STYPES 

607 

348 

END  IF 

STYPES 

6 3 8 

349 

END  IF 

STYPES 

6 0 9 

350 

A 

STYPES 

6 10 

35  1 

A 

STYPES 

6 11 

352 

AAA 

END  PROGRAM  WITHOUT  STORING  DATA  *** 

STYPES 

6 12 

35  3 

A __ 

STYPES 

613 

354 

IF  ( COMMAND  EQ.  7 ) THEN 

STYPES 

6 14 

355 

700 

PRINT* 

STYPES 

615 

356 

PRINT* , ’DOUBLE  CHECK  ! ! ! ' 

STYPES 

6 16 

357 

PRINT*,  ' DO  YOU  WANT  TO  END  THIS  PROGRAM  ', 

STYPES 

617 

358 

+ ’WITHOUT  STORING  DATA?’ 

STYPES 

6 18 

359 

PRINT*,  ’ ENTER  A NUMBER:  (1)  YES 

< 2 ) NO  ' 

STYPES 

619 

360 

REWIND  1 

STYPES 

6 20 

36  1 

READ( 1 , * , END=700)  ANSWER 

STYPES 

621 

362 

A 

STYPES 

622 

36  3 

AAA 

SET  FLAG  FOR  ABORTING  PROGRAM  IN  THE  MAIN  PROGRAM 

STYPES 

623 

364 

IF  ( ANSWER  .EQ.  1 ) THEN 

STYPES 

624 

365 

ABORT  = 1 

STYPES 

625 

366 

RETURN 

STYPES 

6 2.6 

36  7 

A 

STYPES 

627 

368 

AAA 

ABORT  ’STORING'  MODE 

STYPES 

6 28 

369 

ELSE  IF  ( ANSWER  . EQ . 2 ) THEN 

STYPES 

629 

3 70 

PRINT* 

STYPES 

6 30 

37  1 

PRINT*,  ' "ABORTION"  MODE  DISCONTINUED’ 

STYPES 

631 

372 

A 

STYPES 

6 32 

37  3 

AAA 

CHECK  VALIDITY  OF  ANSWER 

STYPES 

633 

374 

ELSE  IF  ( ( ANSWER  . NE . 1 ) .AND  ( ANSWER 

.NE.  2 ) 

) THEN 

STYPES 

6 34 

375 

GOTO  700 

STYPES 

635 

376 

A 

STYPES 

6 36 

377 

END  IF 

STYPES 

637 

3 78 

END  IF 

STYPES 

6 38 

379 

A 

STYPES 

639 

5TYPFS 

6 40 

38  1 

AAA 

LOOP  TO  BEGINNING  OF  ’MANIP’  SUBROUTINE 

STYPES 

641 

0 Q ? 

STYPFr?^ 

6 42 

O U 6 

38  3 

GOTO  10 

STYPES 

643 

384 

A 

STYPES 

6 44 

176 
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385 

RETURN 

STYPES 

6 45 

TRIVIAL*  NO 
386 

PATH  TO  THIS  STATEMENT 
END 

STYPES 

646 

■VARIABLE 

MAP-- 

(LO=A) 

NAME ADDRESS 

--BLOCK 

-PROPERTIES 

TYPE 

---SIZE 

ABORT 

2 

DUMMY-ARG 

INTEGER 

ANSWER 

20  30B 

INTEGER 

COMMAND 

20  40B 

INTEGER 

DOK 

NONE 

UNUSED/ *S* 

INTEGER 

FLAGl 

203  IB 

INTEGER 

INSERT 

NONE 

UNUSED/*S» 

INTEGER 

LOK 

NONE 

UNUSED/ *S* 

INTEGER 

N 

2032B 

INTEGER 

NOK 

NONE 

UNUSED/ *S* 

INTEGER 

OK 

2 033B 

INTEGER 

OKI 

2034B 

INTEGER 

OK  2 

20  35B 

INTEGER 

QUIT 

1 

DUMMY -ARG 

INTEGER 

TDBTOT 

3 2 3B 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

1 40 

TEMP 

NONE 

UNUSED/ *S* 

INTEGER 

TERR 

32  4B 

/TYPEN/ 

INTEGER 

TTOT 

214B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

1 05 

V 

NONE 

UNUSED/ *S* 

INTEGER 

X 

2036B 

INTEGER 

Y 

2037B 

INTEGER 

--SYMBOLIC  CONSTANTS- 
-NAME TYPE 

-( LO=A> 

VALUE 

TMAX  INTEGER 

35 

--PROCEDURES--(LO=A) 

-NAME TYPE 

---ARGS--- 

---CLASS 

DATA  IN 

2 

SUBROUTINE 

DISPLAY 

2 

SUBROUTINE 

--STATEMENT  LABELS--! LO=A) 


LABEL- 

ADDRESS 

--PROPERTIES- 

---DEE 

-LABEL- 

ADDRESS 

--PROPERTIES- 

---DEF 

10 

7B 

35 

300 

5 4 7B 

224 

100 

50B 

61 

305 

61  6B 

248 

200 

133B 

101 

3 10 

INACTIVE 

DO-TERM 

257 

210 

INACTIVE 

DO-TERM 

126 

320 

INACTIVE 

DO-TERM 

260 

220 

INACTIVE 

DO-TERM 

129 

330 

INACTIVE 

DO-TERM 

261 

230 

INACTIVE 

DO-TERM 

130 

500 

74  IB 

295 

250 

INACTIVE 

DO-TERM 

201 

5 10 

74  5B 

2 98 

260 

INACTIVE 

DO-TERM 

204 

600 

lOOlB 

325 

270 

INACTIVE 

DO-TERM 

205 

700 

1 05  3B 

355 

177 
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-ENTRY  PO INTS--( LO=A) 

-NAME --- ADDRESS-- ARCS- -- 

MANIF  5B  2 


-I  10  UNITS--(LO  = A) 
-NAME PROPERTIES 

TAPEl  FMT/SEQ 


-STAT1STIC3-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


20  54B 
37  7B 
63000B 


1068 

255 

26112 


0.553  SECONDS 


1 TRIVIAL 


ERROR  IN  MANIP 


178 


18 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
11 
12 
13 
1 4 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 


SUBROUTINE  DISPLAY  (LINE,  COMMAND)  STYPES 

t ttnttttttiiiiiiiii  util  *iiii  tut  tt  *******%**  ****ttttt*tt*t***t***t*tttt**  lit  **t***COf{J 

•**  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  ***COMT 

titttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt * *COMT 


INTEGER  TMAX 
PARAMETER  (TMAX=35) 

COMMON  /TYPEN/TDIM(TMAX , 4) ,TTOT ,TDB2 (TMAX , 2 ) ,TDBTOT,TERR 
COMMON  /TYPEC/TYPE(TMAX ,3) ,TDB1(TMAX) 

INTEGER  TTOT,TDBTOT,TERR 
REAL  TDIM,TDB2 
CHARACTER  * 3 TYPE.TDBl 


DESCRIPTION  OF  ARRAYS 

ID 

MATERIAL 

FRAME  MATERIAL 

TYPE(X, 1) 
A3 

TYPE(X, 2) 
A3 

TYPE(X, 3) 
A3 

HEIGHT 

WIDTH 

LAYER 

THICKNESS 

DISTANCE 
ABOVE  FLOOR 

TD  I M ( X , 1 ) 
F8  . 2 

TDIM( X, 2) 
F8  . 2 

TDIM( X, 3) 
F8  . 2 

TDIM(  X,  4) 
F8  . 2 

ID 

ATTENUATION 

AREA 

TDBKX) 

A3 

TDB2 (X,  1 ) 
E9  . 3 

TDB2(X,2) 
E9  . 3 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 


tttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt  <(  COMT 


ttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttttt 

INTEGER  LINE,  COMMAND,  N 

10  00  FORMAT  ( 1 X , A5  , 2X  , A 2 , 2X , A8 , 2X , A8 , 2X , A 1 1 , 2X , A9 , 2 X , A8 , 2X , AB ) 

20  00  FORMAT  ( 2X , I 3 , 3X , A2 , 3X , F6  . 2 , 4X , F6  . 2 , 4X , F6 . 2 , 7X , F6 . 2 , 6 X , A3 , 

+ 7X,A3) 

PRINT  1000,  'LINE' ,’ ID' , 'HEIGHT  ', 'WIDTH  ', 'DISTANCE 

' , ' FRAME 

' (METERS) ', 'ABOVE  FLOOR', 
lAL ' , 'MATERIAL ' 


, 1) ,TDIM(LINE, 1) ,TDIM(LINE,2) , 
INE, 3)  ,TYPE(LINE,2)  , TYPE (LINE, 3 


, 1) ,TDIM(LINE, 1) ,TDIM(LINE,2) , 
INE, 3)  , TYPE (LINE, 2) , TYPE (LINE, 3 

END  IF 
RETURN 
END 


10 


+ 'THICKNESS ',' LAYER 

PRINT  10  00  , ' ' , ' ' , ' (METERS)  ' , 

+ ' (CM)  ' , 'MATER 

IF  ( COMMAND  . EQ . 4 ) THEN 
DO  10  LINE  = l,TTOT 

PRINT  2000,  LINE,TYPE(LINE 

+ TDIM( LINE ,4) ,TDIM( L 

CONTINUE 
ELSE 

PRINT  2000,  LINE,T¥PE(LINE 

+ TDIM( LINE , 4) ,TDIM( L 


***d*COMT 

STYPES 
STYPES 
STYPES 
STYPES 
STYPES 
STYPES 
STYPES 
STYPES 
STYPES 
STYPES 
STYPES 
) STYPES 

STYPES 
STYPES 
STYPES 
) STYPES 

STYPES 
STYPES 
STYPES 


647 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 
6 49 
650 
6 51 
652 
6 53 
654 
6 55 
6 5 6 

657 

658 

659 

660 
6 61 
662 
6 63 
664 
6 65 
666 
6 67 


VARIABLE 

MAP-- 

(LO=A) 

•NAME ADDRESS 

-BLOCK 

-PROPERTIES 

TYPE 

---SIZE 

COMMAND 

2 

DUMMY-ARG 

INTEGER 

LINE 

1 

DUMMY-ARG 

INTEGER 

N 

NONE 

UNUSED/ *S* 

INTEGER 

TDBTOT 

323B 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

1 40 

TERR 

32  4B 

/TYPEN/ 

INTEGER 

TTOT 

214B 

/TYPEN/ 

INTEGER 

179 


19 
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TYPE  OB  /TYPEC/  CHAR*3  105 

--SYMBOLIC  CONSTANTS-- ( LO=A) 


-NAME TYPE VALUE 

TMAX  INTEGER  35 


--STATEMENT  L A BE L S- - ( LO  = A ) 

-LAB  EL -ADDRESS PROPERTI  ES DEP 

10  INACTIVE  DO-TERM  44 

1000  163B  FORMAT  33 

2000  171B  FORMAT  34 


--ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARGS 

DISPLAY  5B  2 


--STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


254B  = 172 

37  7B  = 255 

61000B  = 25088 

0 100  SECONDS 
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FUNCTION  VAL  74/175  OPT=0 


1 

INTEGER  FUNCTION  VAL(STRING) 

STYPES 

66 

2 

C**  RETURNS  THE  INTEGER  VALUE  OF  A STRING. 

STYPES 

6 6 

3 

INTEGER  NUMBER,  X , L , EX P , D IG IT , GETLEN 

STYPES 

67 

4 

CHARACTER  » (*)  STRING 

STYPES 

6 7 

5 

L = GETLEN( STRING) 

STYPES 

67 

6 

NUMBER  = 0 

STYPES 

6 7 

7 

DO  10  X = L,  1 , -1 

STYPES 

67 

8 

EXP  = L - X 

STYPES 

6 7 

9 

DIGIT  = ICHAR(STHING(X; X) ) - 16 

STYPES 

67 

10 

NUMBER  = NUMBER  + D I G IT* 1 0 * * EXP 

STYPES 

6 7 

1 1 

10  CONTINUE 

STYPES 

67 

12 

VAL  = NUMBER 

STYPES 

6 7 

13 

RETURN 

STYPES 

68 

14 

END 

STYPES 

6 8 

-VARIABLE  MAP--(LO=A) 

-NAME-- 

-ADDRESS-- 

BLOCK  - -PROPERTIES 

-TYPE 

DIGIT 

76B 

INTEGER 

EXP 

75B 

INTEGER 

L 

74B 

INTEGER 

NUMBER 

72B 

INTEGER 

STRING 

1 

DUMMY-ARG 

CHAR* ( *) 

VAL 

71B 

INTEGER 

X 

73B 

INTEGER 

-PROCEDURES--(LO= 

A) 

-NAME-- 

TYPE-- 

ARGS 

CLASS 

GETLEN 

INTEGER  1 

FUNCTION 

ICHAR 

INTEGER  1 

INTRINSIC 

-STATEMENT  LABELS 

--( LO=A) 

-LABEL- 

ADDRESS  -- 

--PROPERTI ES 

DEF 

1 0 

INACTIVE 

DO-TERM 

11 

-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS 

VAL  6B  1 


-STATIST1CS-- 


PROGRAM-UNIT  LENGTH 

102B 

= 66 

CM  STORAGE  USED 

6 lOOOB 

= 25088 

COMPILE  TIME 

0.041 

SECONDS 

8 

9 

0 

1 

2 

3 

4 

5 

6 

7 

8 

9 

0 

1 
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PTN  5 . 1+552 

FUNCTION  GETLEN 


1 

INTEGER  FUNCTION  GETLEN  /STRING) 

STYPES 

682 

2 

C 

STYPES 

t 83 

3 

C 

DETERMINE  LENGTH  OF  STRING  EXCLUDING  ANY  BLANK  PADDING 

STYFES 

6 84 

4 

C 

STYPES 

6 85 

5 

C 

STYFES 

686 

6 

C 

ARGUMENT  DEFINITIONS  -- 

STYPES 

6 87 

7 

C 

READ  ARGUMENTS 

STYPES 

683 

8 

C 

STRING  - STRING  WHOSE  LENGTH  IS  TO  BE  DETERMINED 

STYFES 

6 89 

9 

C 

STYPES 

690 

1 0 

CHARACTER  * /*)  STRING 

STYPES 

6 91 

1 1 

C 

STYPES 

692 

12 

C 

FUNCTION  PARAMETERS 

STYPES 

6 93 

13 

CHARACTER  » 1 BLANK 

STYPES 

694 

1 4 

PARAMETER  /BLANK  = ' ‘ ) 

STYPES 

6 95 

15 

C 

STYPES 

696 

16 

C 

LOCAL  VARIABLES 

STYPES 

6 97 

17 

INTEGER  NEXT 

STYFES 

698 

18 

C 

STYPES 

6 99 

IV 

C 

START  WITH  THE  LAST  CHARACTER  AND  FIND  THE  FIRST  NON-BLANK 

STYPES 

700 

20 

DO  10  NEXT  = LEN/ STRING) , 1 , -1 

STYPES 

7 01 

21 

IF  /STRING/NEXT  : NEXT)  . NE . BLANK)  THEN 

STYPES 

702 

22 

GETLEN  = NEXT 

STYPES 

703 

23 

RETURN 

STYPES 

704 

24 

END  IF 

STYPES 

7 05 

25 

10  CONTINUE 

STYPES 

706 

26 

C 

STYPES 

7 07 

27 

C 

ALL  CHARACTERS  ARE  BLANKS 

STYPES 

708 

28 

GETLEN  = 0 

STYPES 

7 09 

29 

C 

STYPES 

710 

30 

RETURN 

STYPES 

7 11 

31  END 

VARIABLE  MAP--/LO=A) 

NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 

GETLEN  63B  INTEGER 

NEXT  64B  INTEGER 

STRING  1 DUMMY-ARG  CHAR*/*) 

STYPES 

7 1 2 

-SYMBOLIC  CONSTANTS--/ LO=A) 

-NAME TYPE- VALUE 

BLANK  CHAR*1  ' ' 


-PROCEDURES-- ( LO=A) 

-NAME TYPE ARCS CLASS 

LEN  INTEGER  1 INTRINSIC 


-STATEMENT  L ABE LS- - ( LO = A ) 

-LAB  EL -ADDRESS PROPERTI  ES DEF 

10  INACTIVE  DO-TERM  25 
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FUNCTION  GETLEN  74/175  OPT=0 

--ENTRY  POINTS--/ L0=A) 

-NAME ADDRESS--ARGS 

GETLEN  6B  1 

--STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


70B  = 56 

61000B  = 25088 

0.041  SECONDS 
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SUBROUTINE  LTYPE  74/175  OPT=0 

1 SUBROUTINE  LTYPE  LTYPE  1 

2 *!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! LTYPE  2 

3 » ! ! ! ! ! ! LTYPE  3 

4 »!!!  LOAD  THE  "TYPE"  ARRAYS  FROM  THE  TYPE  DATA  FILE  IMLTYPE  4 

5 » ! M M ! LTYPE  5 

6 *!!!!!!!!!!!  M !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!  M !!!!!!!!!!!!!!!! LTY P E 6 

? **»  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  »*»COMT  2 

11  INTEGER  TMAX  COMT  4 

12  PARAMETER  (TMAX=35)  COMT  5 

13  COMMON  /TYPEN/TDIM(TMAX,4) ,TTOT,TDB2(TMAI,2) ,TDBTOT,TERR  COMT  6 

14  COMMON  /TYPEC/TYPE(TMAI,3)  .TDBKTMAX)  COMT  7 

15  INTEGER  TTOT , TDBTOT , TERR  COMT  8 

16  REAL  TDIM,TDB2  COMT  9 

17  CHARACTER  * 3 TYPE.TDBl  COMT  10 

18  *=================================================  COMT  11 

1?  * DESCRIPTION  OF  ARRAYS  COMT  12 

20  •=================================================  COMT  13 

21  * ID  MATERIAL  FRAME  MATERIAL  COMT  14 

22  * COMT  15 

23  *TYPE(X,1)  TYPE(X,2)  TYPE(X,3)  COMT  16 

24  » A3  A3  A3  COMT  17 

25  *=================================================  COMT  18 

26  * HEIGHT  WIDTH  LAYER  DISTANCE  COMT  19 

27  * THICKNESS  ABOVE  FLOOR  COMT  20 

28  * COMT  21 

29  * TDIM(X,1)  TDIM(X,2)  TDIM(X,3)  TDIM(X,4)  COMT  22 

30  » F8.2  F8.2  F8 . 2 F8 . 2 COMT  23 

31  «=:  = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =:  = = = = = = = = = = = = = = = COMT  24 

32  * ID  ATTENUATION  AREA  COMT  25 

33  * COMT  26 

34  » TDBKX)  TDB2(X,1)  TDB2(X,2)  COMT  27 

35  * A3  E9.3  E9.3  COMT  28 

39  ***  COMMON  FOR  INITIAL  PARAMETERS  **»COMF  2 

40  * * * * * * * 1 1 1 * 1 1 1 * 1 1 1 * * 1 1 * 1 1 1 * * 1 1 1 1 1 1 * * 1 1 * * t * ii  1 1 1 * 1 1 1 1 1 * t * t * * * * * t * 1 1 1 1 * 1 1 1 * QQUY  3 

41  INTEGER  FMAX  COMF  4 

42  PARAMETER  (FMAX  = 50)  COMF  5 

43  COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR,  COMF  6 

44  5 FTOT  COMF  7 

45  COMMON  /INITILC/  BLDG  COMF  8 

46  CHARACTER  * 5 BLDG  COMF  9 

47  REAL  FREQ,  AFLAC,  RFLAG,  FREQA  COMF  10 

48  INTEGER  QUALITY,  FERR,  FTOT  COMF  11 

53  «*•**«*  A *****  *******************  ft  ****************  * LTYPE  10 

52  * DECLARATION  OF  VARIABLES  LTYPE  11 

53  **************************************************  LTYPE  12 

54  INTEGER  GETLEN,  R,  C LTYPE  13 

55  CHARACTER  * 7 PFN  LTYPE  14 

5^  **************************************************  LTYPE  15 

57  * LTYPE  16 

5B  **************************************************  LTYPE  17 

59  PFN  = -B’  II  BLDG< 1 ;GETLEN(BLDG) ) II  'T'  LTYPE  18 

60  TERR  = 0 LTYPE  19 

61  CALL  PF  (■ GET' , 0 ,PFN( 1 :GETLEN(PFN) ), 'RC ', TERR)  LTYPE  20 

62  IF  (TERR  EQ.  0 ) THEN  LTYPE  21 

63  OPEN  (UNIT=3,  F1LE=PFN,  FORM= ' FORMATTED ' , LTYPE  22 

64  $ STATUS='OLD' , ACCESS= ' SEQUENTI AL ' ) LTYPE  23 
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24 


65 

10  00 

FORMAT  ( 1 X, 3( IX , A3  ) , 4 ( IX, F8 . 2)  ) 

LTYPE 

24 

66 

TTOT  = 0 

LTYPE 

1 5 

67 

DO  10  R = 1,TMAX 

LTYPE 

2 6 

68 

READ  (3,1000, END=20) (TYPE(R,C),C=1,3),(TDIM(R,C),C=1,4) 

LTYPE 

27 

69 

TTOT  = TTOT  + 1 

LTYPE 

28 

70 

10 

CONTINUE 

LTYPE 

29 

71 

20 

CONTINUE 

LTYPE 

30 

72 

CLOSE (3 ,STATUS= 'DELETE' ) 

LTYPE 

31 

73 

ELSE  IF  ( TERR  EQ.  2 ) THEN 

LTYPE 

32 

74 

CALL  WARNING  (5) 

LTYPE 

33 

75 

ELSE 

LTYPE 

34 

76 

CALL  WARNING  (6) 

LTYPE 

35 

77 

END  IF 

LTYPE 

36 

78 

RETURN 

LTYPE 

37 

79 

END 

LTYPE 

38 

-VARIABLE  MAP--(LO=A) 

-NAME---ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


AFLAG 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

C 

236B 

INTEGER 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTOT 

67B 

/ INITILN/ 

INTEGER 

PFN 

23  7B 

CHAR*7 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

23  5B 

INTEGER 

RFLAG 

3B 

/ INITILN/ 

REAL 

TDBTOT 

323B 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

35 

TDB2 

21  SB 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

1 40 

TERR 

32  4B 

/TYPEN/ 

INTEGER 

TTOT 

21  4B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

105 

-SYMBOLIC  CONSTANTS-- (LO=A) 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

TMAX  INTEGER  35 


-PROCEDURES--(LOrA) 
-NAME TYPE 

GETLEN  INTEGER 

PP 

WARNING 


ARGS CLASS 

1 FUNCTION 

5 SUBROUTINE 

1 SUBROUTINE 
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SUBROUTINE  LTYPE  74/175  OPT=0 

--ENTRY  FOINTS--(LO=A) 

-NAME --- ADDRESS-- ARGS- -- 

LTYPE  5B  0 


--I 10  UNITS--(LO=A) 
-NAME PROPERTIES 


-STATEMENT  LABELS- -( LO=A ) 


LABEL- 

ADDRESS 

--PROPERTI ES-- 

-DEF 

1 0 

INACTIVE 

DO-TERM 

70 

20 

1 1 IB 

71 

1 000 

147B 

FORMAT 

65 

TAPES  AUX/FMT/SEQ 


--STATISTICS-- 

PROGRAM-UNIT  LENGTH  245B  = 165 

CM  LABELLED  COMMON  LENGTH  470B  = 312 

CM  STORAGE  USED  63000B  = 26112 

COMPILE  TIME  0.107  SECONDS 
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SUBROUTINE  ERROR  74/175  OPT=0 


1 

SUBROUTINE  ERROR(IERR) 

ERROR 

1 

2 

CHARACTER»45 

MESSACE!20) 

ERROR 

2 

3 

DATA 

MESSAGE! 

1 ) / 'MATERIALS 

DATA  BASE 

IS  EMPTY 

■ / 

ERROR 

3 

4 

DATA 

MESSAGE! 

2)1 ' FREQUENCY 

IS  OUT  OF  1 

RANGE 

' / 

ERROR 

4 

5 

DATA 

MESSAGE! 

3) / 'THIS  MATERIAL 

IS  1 

MOT 

IN  DATA  BASE 

' / 

ERROR 

5 

6 

DATA 

MESSAGE! 

4 )/ 'DENOMINATOR  IS  ZERO 

' / 

ERROR 

6 

7 

DATA 

MESSAGE! 

5) / ' FILE  HANDLING 

ERROR 

' / 

ERROR 

n 

8 

DATA 

MESSAGE! 

6) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

8 

9 

DATA 

MESSAGE ! 

7)1' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

9 

10 

DATA 

MESSAGE! 

8) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

10 

1 1 

DATA 

MESSAGE! 

9) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

1 1 

1 2 

DATA 

MESSAGE! 10) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

12 

13 

DATA 

MESSAGE! 11)/' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

13 

1 4 

DATA 

MESSAGE! 12) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

14 

15 

DATA 

MESSAGE!13)/ 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

15 

1 6 

DATA 

MESSAGE! 14) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

U 

17 

DATA 

MESSAGE ! 15 ) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

17 

1 8 

DATA 

MESSAGE! 16) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

18 

19 

DATA 

MESSAGE! 17 ) / ' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

19 

20 

DATA 

MESSAGE! 18) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

20 

21 

DATA 

MESSAGE!!?)/ 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

21 

22 

DATA 

MESSAGE! 20) / 'ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

22 

23 

IERRM=5 

ERROR 

23 

24 

IF ( lERR . GT . lERRM)  IERR=20 

ERROR 

24 

25 

WRITE(6,10)  lERR, MESSAGE! lERR) 

ERROR 

25 

26  10 

FORMAT!'  ***ERROR  NUMBER 

= ' 

,15, 

' * * * 

' , A45  ) 

ERROR 

26 

27 

CALL 

PMDSTOP 

ERROR 

27 

28 

STOP 

' ERROR ' 

ERROR 

28 

29 

END 

ERROR 

29 

-VARIABLE  MAP--!LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES 

TYPE 

---SIZE 

I ERR 

1 DUMMY -ARG 

INTEGER 

lERRM 

210B 

INTEGER 

MESSAGE 

56B 

CHAR*45 

20 

-PROCEDURES--! LO=A) 

-NAME TYPE ARCS CLASS 

PMDSTOP  0 SUBROUTINE 


-STATEMENT  LABELS-- ( LO=A) 

-LAB  EL- ADDRESS PROPERTIES DEF 


10  36B  FORMAT  26 


-ENTRY  POINTS--(LO=A) 
-NAME ---ADDRESS-- ARCS- -- 

ERROR  5B  1 
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SUBROUTINE  ERROR  74/175  OPT=0 

--I/O  UNITS--(LO=A) 

-NAME PROPERTIES 

TAPE6  FMT/SEQ 


--STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


2 1 3B  = 137 

6 1 OOOB  = 25  08  8 

0 054  SECONDS 
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SUBROUTINE  WARNING  74/175  OPT=0 


1 

SUBROUTINE  VARNING(ERR) 

WARNING 

1 

2 

INTEGER  ERR, 

ERRM 

WARNING 

2 

3 

CHARACTER*45 

MESSAGE! 20 ) 

WARNING 

3 

4 

DATA 

MESSAGE 

! 1 ) 

/ ■ "HOLE" 

DATA  FILE 

DOES 

NOT  EXIST 

FOR  THIS 

BLDG  ' / 

WARNING 

4 

5 

DATA 

MESSAGE 

! 2) 

/ ‘ FILE  HANDLING 

PROBLEM 

ON  "HOLE" 

DATA  FILE 

• / 

WARNING 

5 

6 

DATA 

MESSAGE 

! 3) 

/"•MATTER"  FILE 

DOES  NOT 

EXIST  FOR 

THIS  BLDG 

' / 

WARNING 

6 

7 

DATA 

MESSAGE 

! 4) 

/ • FILE  HANDLING 

PROBLEM 

ON  "MATTER 

FILE 

' / 

WARNING 

7 

8 

DATA 

MESSAGE 

! 5 ) 

/ ' "TYPE" 

DATA  FILE 

DOES 

NOT  EXIST 

FOR  THIS 

BLDG  ' / 

WARNING 

8 

9 

DATA 

MESSAGE 

! 6 ) 

/ ' FILE  HANDLING 

PROBLEM 

ON  "TYPE" 

FILE 

’ / 

WARNING 

9 

10 

DATA 

MESSAGE 

! 7 ) 

/ ' "WALL" 

DATA  FILE 

DOES 

NOT  EXIST 

FOR  THIS 

BLDG  ' / 

WARNING 

10 

11 

DATA 

MESSAGE 

! 8) 

/ ' FILE  HANDLING 

PROBLEM 

ON  "WALL" 

FILE 

' / 

WARNING 

1 1 

1 2 

DATA 

MESSAGE 

! 9 ) 

/ ' HEIGHT 

AND  WIDTH 

OF 

ROOM  MISSING 

' / 

WARNING 

1 2 

13 

DATA 

MESSAGE 

! 10  ) 

/ ' LENGTH 

OF  ROOM  IS  MISSING 

' / 

WARNING 

13 

1 4 

DATA 

MESSAGE 

! 11  ) 

/'FREQ  FILE  DOES  NOT  EXIST  FOR  THIS  BLDG 

' / 

WARNING 

14 

15 

DATA 

MESSAGE 

! 12  ) 

/ ' FILE  HANDLING 

PROBLEM 

WITH  FREQ 

FILE 

' / 

WARNING 

15 

16 

DATA 

MESSAGE 

! 13  ) 

/ 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

WARNING 

16 

17 

DATA 

MESSAGE 

! 14  ) 

/ 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

WARNING 

17 

18 

DATA 

MESSAGE 

! 15  ) 

/ 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

• / 

WARNING 

18 

19 

DATA 

MESSAGE 

! 16  ) 

/ 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

WARNING 

19 

20 

DATA 

MESSAGE 

! 17  ) 

/ 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

WARNING 

20 

21 

DATA 

MESSAGE 

! 18  ) 

/ 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

WARNING 

21 

22 

DATA 

MESSAGE 

! 19  ) 

/ 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

WARNING 

22 

23 

DATA 

MESSAGE 

! 20  ) 

/ 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

• / 

WARNING 

23 

24 

ERRM= 

= 12 

WARNING 

24 

25 

I ERR 

= ERR 

WARNING 

25 

26 

IF(ERR . GT. ERRM) 

IERR=20 

WARNING 

26 

27 

WRITE ( 6 , 20 ) 

WARNING 

27 

28 

WRITE (6, 10) 

ERR, MESSAGE! lERR) 

WARNING 

26 

29 

WRITE(6, 20) 

WARNING 

29 

30 

10 

FORMAT!'  ***WARNING  NUMBER  = 

15  , 

' * * 

* 

' ,A45 ) 

WARNING 

30 

31 

20 

FORMAT! ' 

' ) 

WARNING 

3 1 

32 

RETURN 

WARNING 

32 

33 

END 

WARNING 

33 

-VARIABLE  MAP--(LO=A) 
-NAME ADDRESS--BLOCK- 


-PROPERTI  ES TYPE SIZE 


ERR 

ERRM 

lERR 

MESSAGE 


1 DUMMY-ARG 
60B 
2 1 3B 
61E 


INTEGER 

INTEGER 

INTEGER 

CHARM5 


20 


-STATEMENT  LABELS-- ( LO=A) 

-LAB  EL -ADDRESS PROPERTIES DEF 


10  34B  FORMAT 

20  42B  FORMAT 


30 

31 


-ENTRY  POINTS--! LO=A) 
-NAME- --ADDRESS- -ARGS--- 

VARNING  5B  I 
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SUBROUTINE  WARNING  74/175  OPT=0 

--I/O  UNITS--(LO=A) 

-NAME PROPERTIES 

TAPE6  FMT/SEQ 


--STATISTICS-- 

PROGRAM-UNIT  LENGTH  216B  = 142 

CM  STORAGE  USED  61000B  = 25088 

COMPILE  TIME  0.058  SECONDS 
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'program  STREQ  74/175  OPT=0 


1 

PROGRAM  SFREQ  ( I NPUT , TAPE  1 = INPUT ) 

SFREQ 

1 

2 

* 

SFREQ 

? 

3 

*THIS  INTERACTIVE  PROGRAM  INPUTS  THE  DATA  DESCRIBING  EACH  FREQ 

SFREQ 

3 

4 

»IN  THE  BUILDING  AND  STORES  IT.  THE  FILE  NAME  IS  CREATED  BY 

SFREQ 

4 

5 

*ATTACHING  "S'  TO  THE  FRONT  OF  AND  "F"  TO  THE  BACK  OF  THE  BUILDING 

SFREQ 

c 

6 

‘IDENTIFICATION.  THE  BUILDING  IDENTIFICATION  CAN  BE  NO  MORE 

SFREQ 

6 

7 

‘THAN  5 ALPHANUMERIC  CHARACTERS. 

SFREQ 

s 

SFREQ 

s 

9 

*»***»********iinii************iii********iii***»**************fi*******iii** 

* * * * * c OMF 

10 

***  COMMON  FOR  INITIAL  PARAMETERS 

***COMF 

1 1 

***)(«*******lt**«Mlr**««*4Mli«*«M)********  + *)Mli*itilr««****it«ik**«)lr**itii(*it****>t 

* * * ■*  *COMF 

3 

I 2 

INTEGER  FMAX 

COMF 

4 

13 

PARAMETER  (FMAX  = 50) 

COMF 

5 

1 4 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX),  FERR,  COMP 

6 

15 

$ FTOT 

COMF 

7 

1 6 

COMMON  / INITILC/  BLDG 

COMF 

S 

17 

CHARACTER  * 5 BLDG 

COMF 

9 

18 

REAL  FREQ,  AFLAG,  RFLAG,  FREQA 

COMF 

10 

19 

INTEGER  QUALITY,  FERR,  FTOT 

COMF 

1 1 

20 

1 1 1 M i(  1i  it  h i(  t t i(  h 1(  -k  1(  1 1 1 it  t 1 1 1 1 1 ii  t t "k  1 1 1 1 1 1 t t It  i(  1 1 t 1 1 1 1 ii  1 1 1(  1 1 i(  1 1 1(  * t 1 1 1(  t ii  1 1 1 1( 

12 

21 

t it  It  t it  it  it  it  n t ititit  it  t it  K Hitit  Kit  it  it  Hit  it  it  it  it  t it  it  it  t It  it  it  it  tt  It  It  H t it  it  t it  t It  tit  1 1 it  t it  It  It  It  t It*  It  * it  it  It  it  it 

13 

22 

INTEGER  GETLEN,QUIT, ABORT, ANSWER, OLDFI LE ,N,Y1 ,Y2 ,LINE 

SFREQ 

10 

23 

INTEGER  lERR 

SFREQ 

1 1 

24 

CHARACTER  * 7 PFN 

SFREQ 

1 2 

25 

t 

SFREQ 

1 3 

26 

* INITIALIZATION 

SFREQ 

14 

27 

QUIT  = 0 

SFREQ 

1 5 

28 

FTOT  = 0 

SFREQ 

1 6 

29 

ABORT  = 0 

SFREQ 

1 7 

30 

100  PRINT* 

SFREQ 

18 

31 

PRINT  *,  'ENTER  BUILDING  IDENTIFICATION  (EG.  ''101'')' 

SFREQ 

19 

32 

PRINT  ' (NO  MORE  THAN  5 ALPHANUMERIC  CHARACTERS)' 

SFREQ 

20 

33 

REWIND  1 

SFREQ 

21 

34 

READd  ,*  ,END=10Q)  BLDG 

SFREQ 

22 

35 

SFREQ 

2 3 

36 

IF  ( GETLEN(BLDG)  . GT . 5 ) THEN 

SFREQ 

24 

37 

GO  TO  100 

SFREQ 

25 

38 

END  IF 

SFREQ 

2 6 

39 

PFN  = 'B'  II  BLDG( 1 : GETLEN(BLDG) ) II  ‘F’ 

SFREQ 

27 

40 

* 

SFREQ 

28 

41 

***  LOAD  DATA  FROM  EXISTING  FILE  IF  NECESSARY 

SFREQ 

29 

42 

200  PRINT* 

SFREQ 

30 

43 

PRINT* , 'WILL  THIS  BE ’ 

SFREQ 

31 

44 

PRINT*,'  (1)  A MODIFICATION  OF  AN  EXISTING  FILE?' 

SFREQ 

32 

45 

PRINT* , ' ( 2 ) A NEW  FILE?  ' 

SFREQ 

33 

46 

PRINT* ,' ENTER  A NUMBER  M!' 

SFREQ 

34 

47 

REWIND  1 

SFREQ 

35 

48 

READ( 1 , * , END=200 ) OLDFILE 

SFREQ 

3 6 

49 

IF  ( ( OLDFILE  NE.  1 ) .AND.  ( OLDFILE  . NE . 2 ) ) THEN 

SFREQ 

37 

50 

GOTO  200 

SFREQ 

38 

51 

ELSE  IF  ( OLDFILE  EQ.  1 ) THEN 

SFREQ 

39 

52 

* 

SFREQ 

40 

53 

***  CHECK  FOR  EXISTENCE  OF  PERMANENT  FILE  OF  SAME  NAME 

SFREQ 

41 

54 

lERR  = 0 

SFREQ 

42 

55 

CALL  PF  ( ' GET'  , 0 , PFN( 1 : GETLEN( PFN) ) , ' RC ' , lERR) 

SFREQ 

4 3 

56 

IF  ( lERR  .EQ.  2 ) THEN 

SFREQ 

44 

57 

PRINT* 

SFREQ 

45 

58 

PRINT  *,  'FILE  ',PFN,  ' NOT  FOUND' 

SFREQ 

46 

59 

PRINT*,  ' PROGRAM  ABORTED !!! ' 

SFREQ 

47 

60 

PRINT* 

SFREQ 

48 

61 

PRINT*,  'FIND  CORRECT  BUILDING  IDENTIFIER  AND  RESTART  ', 

SFREQ 

49 

62 

+ 'PROGRAM' 

SFREQ 

50 

63 

PRINT* 

SFREQ 

51 

64 

STOP 

SFREQ 

52 
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65 

t 

SFREQ 

5 3 

66 

ELSE 

SFREQ 

j 4 

67 

CALL  LFREQ 

SFREQ 

c c 

6B 

IF  (FERR  .NE.  0)  CALL  ERROR(5) 

SFREQ 

56 

69 

END  IF 

SFREQ 

57 

70 

ELSE  IF  ( OLDFILE  . EQ . 2 ) THEN 

SFREQ 

58 

71 

* 

SFREQ 

59 

72 

*»*  CHECK  FOR  EXISTENCE  OF  PERMANENT  FILE  OF  SAME  NAME 

SFREQ 

60 

73 

lERR  = 0 

SFREQ 

6 1 

74 

CALL  PF  ( 'GET' , 0 ,PFN( 1 ;GETLEN(PFN) > , 'RC ' , lERR) 

SFREQ 

62 

75 

IF  ( lERR  EQ.  0 ) THEN 

SFREQ 

6 3 

76 

PRINT* 

SFREQ 

64 

77 

PRINT*,  'DATA  FILE  ALREADY  EXISTS  FOR  BUILDING  ',BLDG 

SFREQ 

6 5 

78 

PRINT* 

SFREQ 

66 

79 

PRINT*, 'IF  YOU  ENTER  DATA  AND  STORE  IT,  YOU  WILL  WRITE  ', 

SFREQ 

67 

eo 

+ 

'OVER  THE  OLD  FILE  . ' 

SFREQ 

68 

B1 

250 

PRINT* 

SFREQ 

69 

82 

PRINT*, 'YOU  MAY  EITHER  (1)  ABORT  OR  (2)  CONTINUE.' 

SFREQ 

70 

83 

PRINT* ,' INDICATE  YOUR  CHOICE  BY  ENTERING  A NUMBER.' 

SFREQ 

71 

84 

REWIND  1 

SFREQ 

72 

85 

READd  , * , END  = 250  ) ANSWER 

SFREQ 

73 

86 

IF  ( ANSWER  .EQ.  1 ) THEN 

SFREQ 

74 

87 

PRINT* 

SFREQ 

75 

88 

PRINT* ,' PROGRAM  HAS  BEEN  ABORTED,  AT  YOUR  REQUEST' 

SFREQ 

76 

89 

PRINT* 

SFREQ 

77 

90 

STOP 

SFREQ 

78 

91 

ELSE  IF  ( ANSWER  EQ.  2 ) THEN 

SFREQ 

79 

92 

9 0 90 

CONTINUE 

SFREQ 

80 

93 

ELSE 

SFREQ 

81 

94 

GOTO  250 

SFREQ 

82 

95 

END  IF 

SFREQ 

83 

96 

ELSE  IF  ( lERR  EQ.  2 ) THEN 

SFREQ 

84 

97 

* 

SFREQ 

85 

98 

* **  NO 

DATA  FILE  ALREADY  EXISTS  FOR  THIS  BUILDING  AND  DATA  ENTRY 

SFREQ 

86 

99 

***  CAN  CONTINUE 

SFREQ 

87 

1 00 

9091 

CONTINUE 

SFREQ 

88 

10  i 

ELSE 

SFREQ 

89 

102 

* 

SFREQ 

90 

103 

***  PERMANENT  FILE  ERROR 

SFREQ 

91 

104 

PRINT* 

SFREQ 

92 

105 

PRINT* ,' PROGRAM  ABORTED  !!!' 

SFREQ 

93 

106 

PRINT*,'  SOME  PERMANENT  FILE  ERROR  HAS  OCCURRED.' 

SFREQ 

94 

107 

PRINT*,'  DOUBLE  CHECK  YOUR  BUILDING  IDENTIFICATION  ', 

SFREQ 

95 

108 

+ 

'AND  TRY  AGAIN' 

SFREQ 

96 

109 

STOP 

SFREQ 

97 

1 10 

END  IF 

SFREQ 

98 

11  1 

* 

SFREQ 

99 

112 

PRINT* 

SFREQ 

100 

113 

PRINT*,  ' BEGIN  ENTERING  DATA' 

SFREQ 

101 

1 14 

300 

FTOT  = FTOT  + 1 

SFREQ 

102 

115 

IF  ( FTOT  .EQ.  1)  THEN 

SFREQ 

103 

1 16 

CALL  DATAINd  , FTOT) 

SFREQ 

104 

117 

ELSE 

SFREQ 

105 

118 

CALL  DATAIN  (0,FTOT) 

SFREQ 

106 

119 

END  IF 

SFREQ 

107 

120 

400 

PRINT* 

SFREQ 

108 

12  1 

PRINT*,  'DO  YOU  WANT  TO  ENTER  MORE  DATA?', 

SFREQ 

109 

122 

+ 

' d ) YES  (2)  NO' 

SFREQ 

1 10 

123 

PRINT*,  ' ENTER  A NUMBER  !!!' 

SFREQ 

1 1 1 

124 

REWIND  1 

SFREQ 

1 12 

125 

READd  ,*,  END  = 400  ) ANSWER 

SFREQ 

1 1 3 

126 

IF  ( (ANSWER  .NE.  1)  .AND.  (ANSWER  .NE.  2)  ) THEN 

SFREQ 

1 1 4 

127 

GOTO  400 

SFREQ 

1 1 5 

128 

ELSE  IF  ( ANSWER  EQ.  1)  THEN 

SFREQ 

1 1 6 
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129 

GOTO  300 

SFREQ 

1 1 7 

130 

ELSE  IF  ( ANSWER  EQ.  2 ) THEN 

3FREG 

1 18 

13  1 

PRINT* 

SFREQ 

1 1 9 

132 

PRINT*,  'DATA  ENTRY  DISCONTINUED' 

SFREQ 

120 

133 

END  IF 

SFREQ 

121 

134 

END  IF 

SFREQ 

122 

135 

* 

SFREQ 

123 

136 

* * * 

MANIPULATE  DATA 

SFREQ 

124 

137 

CALL  MANIP  (QUIT, ABORT) 

SFREQ 

12  5 

1 36 

A 

SFREQ 

126 

139 

* * A 

TERMINATE  PROGRAM,  STORING  DATA  IF  NECESSARY 

SFREQ 

127 

140 

IF  ( QUIT  .EQ.  1 ) THEN 

SFREQ 

126 

14  1 

OPEN(UNIT=6 , FILE=PFN( 1 : GETLEN(PFN) ) ,FORM= ' FORMATTED ' , 

SFREQ 

129 

142 

+ ACCESS= 'SEQUENTIAL' , STATUS= ‘ NEW ' ) 

SFREQ 

130 

143 

500 

FORMAT  (1PE12.6) 

SFREQ 

13  1 

144 

DO  600  N = 1 , FTOT 

SFREQ 

132 

145 

WRITE  (6,500)  FREQA(N) 

SFREQ 

133 

146 

600 

CONTINUE 

SFREQ 

13  4 

147 

ENDFILE(6) 

SFREQ 

135 

1 48 

WARNING* 

CALL  PF  ( 'REPLACE' ,0 ,PFN(1 :GETLEN(PFN) ) ) 

NUMBER  OF  ARGUMENTS  IN  REFERENCE  TO  _PF  IS  NOT  CONSISTENT 

SFREQ 

136 

149 

CLOSE(6  , STATUS:: 'DELETE  ■ ) 

SFREQ 

137 

150 

PRINT* 

SFREQ 

136 

15! 

PRINT*, 'DATA  HAS  BEEN  STORED  AND  PROGRAM  TERMINATED' 

SFREQ 

1 39 

152 

END  IF 

SFREQ 

140 

153 

IF(  ABORT  .EQ.  1 ) THEN 

SFREQ 

141 

154 

PRINT* 

SFREQ 

142 

155 

PRINT*,  'PROGRAM  HAS  BEEN  ABORTED' 

SFREQ 

1 43 

156 

PRINT*,'  NO  DATA  HAS  BEEN  STORED  !!!' 

SFREQ 

144 

157 

END  IF 

SFREQ 

145 

15  8 

STOP 

SFREQ 

146 

159 

END 

SFREQ 

147 

--VARIABLE  MAP--(LO=A) 

-NAME ---ADDRESS --BLOCK PROPERTIES TYPE SIZE 


ABORT 

1031B 

INTEGER 

AFLAG 

2B 

/ INITILN/ 

REAL 

ANSWER 

1 032B 

INTEGER 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

FTOT 

67B 

/ INITILN/ 

INTEGER 

lERR 

1 035B 

INTEGER 

LINE 

NONE 

UNUSED/ 

*s* 

INTEGER 

N 

1 034B 

INTEGER 

OLDFILE 

1 0 3 3B 

INTEGER 

PFN 

1 0 3 6B 

CHAR*7 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

QUIT 

1 0 3 0B 

INTEGER 

RFLAG 

3B 

/ INITILN/ 

REAL 

Y1 

NONE 

UNUSED/ 

*s* 

INTEGER 

Y2 

NONE 

UNUSED/ 

*s* 

INTEGER 

190 
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-SYMBOLIC  CONSTANTS--! LO=A) 

-NAME TYPE-- VALUE 

FMAX  INTEGER  50 


-PROCEDURES--(LO=A) 
-NAME TYPE 

--ARGS 

---CLASS 

-NAME 

---TYPE 

ARCS 

CLASS 

DATA  IN 

2 

SUBROUTINE 

LFREQ 

0 

SUBROUTINE 

ERROR 

1 

SUBROUTINE 

MANIP 

2 

SUBROUTINE 

GETLEN  INTEGER 

1 

FUNCTION 

PF 

5 

SUBROUTINE 

-STATEMENT  LABELS- 

-( LO=A) 

-LABEL- 

ADDRESS 

-PROPERTIES-- 

--DEF 

-LABEL-ADDRESS 

--PROPERTIES--- 

-DEF 

100 

2 IB 

30 

500  570B 

FORMAT 

1 43 

200 

47B 

42 

600  INACTIVE 

DO-TERM 

146 

250 

166B 

81 

9090  *NO  REFS* 

92 

300 

2 4 6B 

114 

9091  *NO  REFS* 

100 

400 

26  0B 

120 

-ENTRY  POINTS--(LO=A) 
-NAME ---ADDRESS-- ARCS 

SFREQ  14B  0 


-I/O  UNITS--(LO=A) 
-NAME PROPERTIES- 

TAPEl  FMT/SEQ 
TAPE6  AUX/FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


1040B  = 544 

7 IB  = 57 

83000B  = 28112 

0.260  SECONDS 


1 WARNING  ERROR  IN  SFREQ 


191 
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1 SUBROUTINE  DATAIN  ( I NSERT , L I NE ) SPREQ  148 

1 *«**«'«**iK***«««**««(**«it4i«nli«*«****«*iii***«[**«*******«r***«t***iktt*«««**«i**««(<COI^r  1 

3 ***  COMMON  FOR  INITIAL  PARAMETERS  ***COMF  2 

4 ****«c*<(*****iii**«i«x*)li<[*****iii*********«*«r*lt******4i**ili*«*lttk***«iii**<i**«il:*«*«(;OMF  3 


5 

INTEGER  FMAX 

COMF 

4 

6 

PARAMETER  (FMAX  = 50) 

COMF 

5 

7 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQACFMAX), 

FERR,  COMF 

6 

8 

$ FTOT 

COMF 

7 

9 

COMMON  /INITILC/  BLDG 

COMF 

8 

10 

CHARACTER  * 5 BLDG 

COMF 

9 

1 1 

REAL  FREQ,  AFLAC,  RFLAC,  FREQA 

COMF 

1 0 

12 

INTEGER  QUALITY,  FERR,  FTOT 

COMF 

1 1 

13 

t'k'ktiftiitil'k'kt'k'kt'k'kt'kt'kt'kttt'kttt'k'kttttttit'kt'kttt'k'kil'kil'k'k'k'kiili'k'k'ktiitt'k 

» * * * t * * *COMF 

1 2 

1 4 

t 1 1 t 1 1 t 1 1 * k t 1 1 t * t h * 1 1 1 * 1i  k 1 1 * t * * 1 1 h * ti  1 1(  * t * Irk  t t * * 1 1i  t t * * It  * t t t * i(  * t H 1 1 ii  * * It  ii  it  *. 

* ^ 

15 

INTEGER  INSERT, LINE 

SFREQ 

150 

1 6 

IFdNSERT.EQ  1)  THEN 

SFREQ 

151 

17 

200 

PRINT  *,  ' ENTER  FREQUENCY  FOR  LINE  #',LINE 

SFREQ 

152 

18 

300 

READd  ,*  ,END  = 2 00  ,ERR  = 20  0 ) FREQA  (LINE) 

SFREQ 

153 

19 

END  IF 

SFREQ 

1 5 4 

20 

IF( INSERT. EQ. 0)  THEN 

SFREQ 

155 

21 

400 

PRINT  *,  'ENTER  NEXT  FREQS,  ONE  PER  LINE  AFTER'  , 

SFREQ 

156 

22 

+ ' EACH  QUESTION  MARK . ’ 

SFREQ 

157 

23 

PRINT  *,  ' ENTER  ZERO  (0.0)  TO  DISCONTINUE  ENTRIES' 

SFREQ 

158 

24 

PRINT  *,  'START  WITH  LINE  NUMBER  = ',  LINE 

SFREQ 

159 

25 

500 

REWIND  1 

SFREQ 

160 

28 

READd ,* ,END=400 , ERR=400 ) FREQA (LINE) 

SFREQ 

161 

27 

IF(FREQA(LINE ) ,GT. 0 . 0)  THEN 

SFREQ 

162 

28 

irk'kkltitk'kkltkltk'kicirkliititkf.  kk1(ki(1rk'k1(it*i(tk1i1(kkk1(t1(1t'k'kk1(t'ki(k1rk 

SFREQ 

163 

29 

* CHECK  IF  ARRAY  SIZE  EXCEEDED 

SFREQ 

164 

30 

A****************************************************** 

SFREQ 

165 

31 

IF(  LINE . GT . FMAX ) THEN 

SFREQ 

166 

32 

PRINT  *,  'MAXIMUM  NUMBER  OF  DATA  LINES  CANNOT  ' 

SFREQ 

167 

33 

PRINT  *,  'EXCEED  ',  FMAX,  INSERTION  NOT  POSSIBLE.' 

SFREQ 

168 

34 

RETURN 

SFREQ 

169 

35 

END  IF 

SFREQ 

170 

36 

***H*#l*********llt*************************************** 

SFREQ 

171 

37 

LINE  = LINE  + 1 

SFREQ 

172 

38 

GOTO  500 

SFREQ 

173 

39 

ELSE 

SFREQ 

174 

40 

LINE  =LINE  -1 

SFREQ 

175 

41 

END  IF 

SFREQ 

176 

42 

END  IF 

SFREQ 

177 

43 

RETURN 

SFREQ 

178 

44 

END 

SFREQ 

179 

-VARIABLE  MAP-- 
-NAME ADDRESS 

(LO=A) 

--BLOCK PROPERTIES 

TYPE 

AFLAG 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

FERR 

6 6B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

FTOT 

67B 

/INITILN/ 

INTEGER 

INSERT 

1 

DUMMY-ARG 

INTEGER 

LINE 

2 

DUMMY-ARG 

INTEGER 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

RFLAG 

3B 

/ INITILN/ 

REAL 

SIZE 


50 
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6 


-SYMBOLIC  CONSTANTS--! LO=A) 


-NAME TYPE VALUE 

PMAX  INTEGER  50 


-STATEMENT 

LABELS- 

- ! LO=A) 

-LABEL- 

ADDRESS 

-PROPERTIES- 

---DEF 

200 

1 2B 

17 

300 

*NO 

REFS* 

18 

400 

25B 

21 

500 

33B 

25 

-ENTRY  POINTS--! LO=A) 
-NAME ADDRESS--ARGS 

DATAIN  5B  2 


-I/O  UNITS--!LO=A) 
-NAME---  PROPERTIES 

TAPEl  FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


200B  = 128 

7 IB  = 57 

61000B  = 25088 

0.073  SECONDS 
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7 


1 

2 


4 

5 

6 
7 
B 
9 

10 
1 1 
12 

13 

14 

15 
1 6 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


SUBROUTINE  MANIP  (QUIT, ABORT) 

***  COMMON  FOR  INITIAL  PARAMETERS  * 

*************)i(**)i(****A**A!)i;iii********]l(***<i***iir**A****#(<t****<t*ft**H**A**A* 

INTEGER  FMAX 
PARAMETER  (FMAX  = 50) 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR, 
5 FTOT 

COMMON  /INITILC/  BLDG 
CHARACTER  * 5 BLDG 
REAL  FREQ,  AFLAG,  RFLAG,  FREQA 
INTEGER  QUALITY,  FERR,  FTOT 

INTEGER  ABORT, ANSWER , DOK, FLAGl , LOK,N,NOK,OK , OK  1 , OK2 , QU IT , INSERT 
INTEGER  TEMP, V,X,Y, COMMAND 
CHARACTER  » 3 DIR,  FROM,  TO 


SFREQ 

**COMF 

**COMF 

**COMF 

COMF 

COMF 

COMF 

COMF 

COMF 

COMF 


* 

10 


FLAGl  = 
PRINT* 
PRINT* , 
PRINT* , 
PRINT* , 
PRINT* , 

I- 

PRINT* , 


CHOOSE 
( 1) 
(2) 
(3) 

PROGRAM 


DISPLAY  LINE  OF  DATA  (4)  DISPLAY  ALL  LINES' 
INSERT  LINE  INTO  FILE  (5)  APPEND  LINES  OF  DATA' 
DELETE  LINE  (6)  STORE  DATA  AND  EXIT  ' 

(7)  EXIT  PROGRAM  WITHOUT 


STORING  DATA' 
PRINT*,  'ENTER  A NUMBER  ' 
PRINT* 

REWIND  1 

READ ( 1 , * , END=1 0 ) COMMAND 


a ** 
% 


« 

* * * 


* 

*h  * 
100 


* 

t*  * 


DISPLAY  LINE  *** 

IF  ( COMMAND  EQ.  1 ) THEN 

INDICATE  EMPTY  DATA  FILE 

IF  ( FTOT  EQ.  0 ) THEN 
PRINT* 

PRINT*,  'DATA  FILE  IS  EMPTY  !!!' 

ENTER  NUMBER  OF  LINE  TO  BE  DISPLAYED 
ELSE 
PRINT* 

PRINT*,  'SPECIFY  THE  NUMBER  OF  THE  LINE  TO  BE  DISPLAYED' 
PRINT*,  ' ( ENTER  "0"  TO  ESCAPE  DISPLAY  MODE  )' 

REWIND  1 

READ( 1 , * , END=100)  N 

CHECK  VALIDITY  OF  LINE  NUMBER 

IF  ( (N  ,GT.  FTOT)  .OR.  (N  LT.  0)  ) THEN 
PRINT* 

PRINT*,  'INCORRECT  NUMBER  !!!!!!  TRY  AGAIN  !!!' 

PRINT*,  ' -OR-  ENTER  "0"  TO  ESCAPE  FROM  ', 

+ ' "DISPLAY"  MODE ' 

GOTO  100 


* 

AAA 


ABORT  'DISPLAY'  MODE 

ELSE  IF  ( N EQ.  0 ) THEN 
PRINT* 

PRINT*,  ’ "DISPLAY"  MODE  ABORTED  !!!' 

* 

***  DISPLAY  LINE  OF  DATA 


180 

1 

2 

3 

4 

5 

6 

7 

8 
9 


COMF 

1 0 

COMF 

1 1 

'COMF 

12 

13 

SFREQ 

182 

SFREQ 

183 

SFREQ 

184 

SFREQ 

185 

SFREQ 

186 

SFREQ 

187 

SFREQ 

188 

SFREQ 

189 

SFREQ 

190 

SFREQ 

191 

SFREQ 

192 

SFREQ 

193 

SFREQ 

194 

SFREQ 

195 

SFREQ 

196 

SFREQ 

197 

SFREQ 

198 

SFREQ 

1 99 

SFREQ 

200 

SFREQ 

201 

SFREQ 

202 

SFREQ 

203 

SFREQ 

204 

SFREQ 

2 05 

SFREQ 

206 

SFREQ 

207 

SFREQ 

208 

SFREQ 

209 

SFREQ 

210 

SFREQ 

2 11 

SFREQ 

212 

SFREQ 

2 13 

SFREQ 

214 

SFREQ 

2 15 

SFREQ 

2 1 6 

SFREQ 

2 17 

SFREQ 

218 

SFREQ 

2 19 

SFREQ 

220 

SFREQ 

221 

SFREQ 

222 

SFREQ 

223 

SFREQ 

224 

SFREQ 

225 

SFREQ 

226 

SFREQ 

227 

SFREQ 

228 

SFREQ 

229 

SFREQ 

230 

SFREQ 

231 
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85 

86 
o7 
88 

69 

70 

71 

72 

73 

74 

75 
78 

77 

78 

79 

80 
81 
82 

83 

84 

85 
88 

87 

88 

89 

90 

91 

92 

93 

94 

95 
98 

97 

98 

99 
100 
10  1 
102 

103 

104 

105 
108 
107 
1 08 
109 
1 10 
11  1 
112 

113 

114 

115 
118 
117 
1 18 
119 
1 20 
12  1 
122 

123 

124 

125 
128 

127 

128 


ELSE  IF  ( (N  GT  0)  AND.  (N  . LE . FTOT)  ) THEN 
PRINT* 

CALL  DISPLAY!  N,  COMMAND) 


END  IF 
END  IF 
END  IF 


« 

***  INSERT  LINE  *** 


IF  ( COMMAND  . EQ  2 ) THEN 

t 

***  INDICATE  EMPTY  DATA  FILE 

IF  ( FTOT  .EQ.  0 ) THEN 
PRINT* 

PRINT*,  'DATA  FILE  IS  EMPTY  !!!' 

* 

***  REQUEST  NUMBER  OF  LINE  BEFORE  WHICH  INSERTION  IS  TO  BE  MADE 
ELSE 

200  PRINT* 

PRINT*,  'SPECIFY  NUMBER  OF  LINE  BEFORE  WHICH  A NEW  LINE  IS 
+ 'TO  BE  INSERTED' 

PRINT*,  ' ( ENTER  "0"  TO  ESCAPE  "INSERTION"  MODE  )' 

REWIND  1 

READ!! , * ,END=200)  N 

« 

***  CHECK  FOR  VALID  LINE  NUMBER 

IF  ( ( N LT.  0 ) OR.  ( N . GT . FTOT  ) ) THEN 
PRINT* 

PRINT*,  'INCORRECT  LINE  NUMBER  !!!' 

PRINT*,  ' TRY  AGAIN  !!!  -OR-  ENTER  "0"  TO  ESCAPE', 

+ ' " INSERTION"  MODE ' 

GOTO  200 

* 

***  ABORT  INSERTION  MODE 

ELSE  IF  ( N EQ.  0 ) THEN 
PRINT* 

PRINT*,  ' "INSERTION"  MODE  ABORTED' 

* 

***  MAKE  ROOM  FOR  NEW  LINE  OF  DATA 

ELSE  IF  ( (N  .GT.  0)  .AND.  (N  .LE.  FTOT)  ) THEN 

* CHECK  IF  ARRAY  SIZE  EXCEEDED 

*ii*1i1i*1i1i1i*t1i*1i1ii(tt1fkt1i****1i****t****t*1i1i1t******t1t****** 

IF(  FTOT. EQ. FMAX)  THEN 

PRINT  *,  'MAXIMUM  NUMBER  OF  DATA  LINES  CANNOT  ' 

PRINT  *,  'EXCEED  ',  FMAX,  '.  INSERTION  NOT  POSSIBLE.' 

GO  TO  10 
END  IF 

DO  230  X = FTOT,N,-l 

FREQA(X+1)  = FREQA(X) 

210  CONTINUE 

230  CONTINUE 

* 

***  ENTER  DATA  FOR  NEW  LINE 
FTOT  = FTOT  + 1 
CALL  DATAIN  (1 ,N) 

* 

PRINT* 

PRINT*,  'THE  FOLLOWING  LINE  HAS  BEEN  ADDED  AS  LINE  ',  N 
CALL  DISPLAY!  N,  COMMAND) 

END  IF 


SFREQ 

2 32 

SFREQ 

2 33 

SFREQ 

234 

SFREQ 

13  5 

SFREQ 

238 

SFREQ 

2 37 

SFREQ 

238 

SFREQ 

2 39 

SFREQ 

240 

SFREQ 

241 

SFREQ 

242 

SFREQ 

243 

SFREQ 

244 

SFREQ 

2 45 

SFREQ 

248 

SFREQ 

247 

SFREQ 

248 

SFREQ 

2 49 

SFREQ 

250 

SFREQ 

251 

SFREQ 

252 

SFREQ 

253 

SFREQ 

254 

SFREQ 

253 

SFREQ 

258 

SFREQ 

257 

SFREQ 

253 

SFREQ 

25? 

SFREQ 

280 

SFREQ 

281 

SFREQ 

282 

SFREQ 

263 

SFREQ 

284 

SFREQ 

285 

SFREQ 

288 

SFREQ 

287 

SFREQ 

288 

SFREQ 

269 

SFREQ 

270 

SFREQ 

271 

SFREQ 

272 

SFREQ 

273 

SFREQ 

274 

SFREQ 

275 

SFREQ 

278 

SFREQ 

2 77 

SFREQ 

278 

SFREQ 

279 

SFREQ 

280 

SFREQ 

281 

SFREQ 

282 

SFREQ 

283 

SFREQ 

284 

SFREQ 

285 

SFREQ 

288 

SFREQ 

287 

SFREQ 

288 

SFREQ 

289 

SFREQ 

290 

SFREQ 

291 

SFREQ 

292 

SFREQ 

293 

SFREQ 

294 

SFREQ 

295 
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129 

END  IF 

SFREQ 

296 

130 

END  IF 

SFREQ 

2 97 

13  1 

* 

SFREQ 

298 

1 32 

* _ . 

SFREQ 

133 

A * * 

DELETE  LINE  *** 

SFREQ 

300 

134 

A 

SFREQ 

135 

IF  ( COMMAND  . EQ . 3 ) THEN 

SFREQ 

302 

1 36 

A 

SFREQ 

303 

137 

AAA 

INDICATE  EMPTY  DATA  FILE 

SFREQ 

304 

1 38 

IF  < FTOT  EQ.  0 ) THEN 

SFREQ 

3 05 

139 

PRINT* 

SFREQ 

306 

140 

PRINT*,  'DATA  FILE  IS  EMPTY 

M ! • 

SFREQ 

3 07 

14  1 

A 

SFREQ 

308 

142 

AAA 

READ  NUMBER  OF  LINE  TO  BE  DELETED 

SFREQ 

309 

14  3 

ELSE 

SFREQ 

310 

144 

300 

PRINT* 

SFREQ 

3 1 1 

145 

PRINT*,  'SPECIFY  THE  NUMBER 

OF  THE  LINE  TO 

BE  DELETED' 

SFREQ 

312 

1 46 

PRINT*,  ' (ENTER  "0"  TO  ESCAPE  DELETION 

MODE) ' 

SFREQ 

3 1 3 

147 

REWIND  1 

SFREQ 

3 1 4 

148 

READd  ,*,END  = 3 0 0 ) N 

SFREQ 

3 15 

149 

A 

SFREQ 

316 

150 

AAA 

CHECK  VALIDITY  OF  LINE  NUMBER 

SFREQ 

3 17 

15  1 

IF  ( (N  GT.  FTOT  ) OR.  ( N 

.LT.  0 ) 

) THEN 

SFREQ 

318 

152 

PRINT* 

SFREQ 

3 19 

153 

PRINT*,  ' INCORRECT  NUMBER 

MM 

SFREQ 

320 

154 

PRINT* , ' TRY  AGAIN  ! ! ! 

-OR-  ENTER 

"0"  TO  ESCAPE  FROM' 

, SFREQ 

321 

155 

+ '"DELETE"  MODE' 

SFREQ 

322 

156 

GOTO  300 

SFREQ 

323 

157 

A 

SFREQ 

324 

158 

AAA 

ABORT  'DELETE'  MODE 

SFREQ 

325 

159 

ELSE  IF  ( N .EQ.  0 ) THEN 

SFREQ 

326 

160 

PRINT*,  ' "DELETE"  MODE  ABORTED' 

SFREQ 

327 

161 

A 

SFREQ 

328 

162 

AAA 

DOUBLE  CHECK  CHOICE  OF  LINE  TO  BE 

DELETED 

SFREQ 

329 

16  3 

ELSE  IF  ((  N GT.  0 ) .AND. 

( N . LE . 

FTOT 

))  THEN 

SFREQ 

330 

164 

PRINT* 

SFREQ 

331 

165 

PRINT* , 'DOUBLE  CHECK  !! ! ' 

SFREQ 

332 

166 

PRINT*,  ' DO  YOU  WANT 

TO  DELETE 

THE 

FOLLOWING  LINE? : ' 

SFREQ 

333 

167 

CALL  DISPLAY!  N,  COMMAND) 

SFREQ 

334 

1 68 

305 

PRINT*,  ' ENTER  (1)  YES 

OR  ( 2 ) 

NO  ' 

SFREQ 

335 

169 

REWIND  1 

SFREQ 

336 

170 

READd  ,*  ,END  = 30  5 > ANSWER 

SFREQ 

337 

17  1 

A 

SFREQ 

338 

172 

AAA 

DELETE  LINE 

SFREQ 

339 

173 

IF  ( ANSWER  EQ.  1 ) THEN 

SFREQ 

340 

174 

DO  330  X = N,  FTOT  - 1 

SFREQ 

341 

175 

FREQA(X)  = FREQA(X+1) 

SFREQ 

342 

176 

330 

CONTINUE 

SFREQ 

343 

177 

FTOT  = FTOT  - 1 

SFREQ 

344 

178 

PRINT* 

SFREQ 

345 

17  9 

PRINT*,  'LINE  I ',N,'  DELETED' 

SFREQ 

346 

180 

END  IF 

SFREQ 

347 

18  1 

A 

SFREQ 

348 

182 

END  IF 

SFREQ 

3 49 

183 

END  IF 

SFREQ 

350 

184 

END  IF 

SFREQ 

351 

185 

A 

SFREQ 

352 

1 Q 1 

SFR  FO 

^ ^ 

18  7 

AAA 

DISPLAY  ALL  DATA  *** 

SFREQ 

354 

18  6 

A . ..  . 

fn 

ss 

189 

IF  { COMMAND  .EQ.  4 ) THEN 

SFREQ 

356 

1 90 

A 

SFREQ 

357 

19  1 

AAA 

INDICATE  EMPTY  DATA  FILE 

SFREQ 

358 

192 

IF  ( FTOT  EQ.  0 ) THEN 

SFREQ 

359 

196 
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193 

PRINT* 

3FREQ 

36  0 

194 

PRINT*,  ’DATA  FILE  IS  EMPTY  !!!' 

SFHEQ 

361 

195 

t 

SFREQ 

362 

196 

t t t 

DISPLAY  DATA 

SFREG 

363 

197 

ELSE 

SFREQ 

364 

198 

PRINT* 

SFREQ 

3 6 5 

19  9 

CALL  DISPLAY!  N,  COMMAND) 

SFREQ 

3 6 6 

200 

t 

SFREQ 

367 

20  1 

END  IF 

SFREQ 

368 

202 

END  IF 

SFREQ 

3 69 

203 

t 

SFREQ 

370 

204 

t 

SFREQ 

3 71 

205 

t t t 

ADD  DATA  *** 

SFREQ 

372 

206 

SFREQ 

* 7 3 

207 

IF  ( COMMAND  EQ.  5 ) THEN 

SFREQ 

374 

208 

t 

SFREQ 

3 75 

209 

K t t 

ENTER  DATA 

SFREQ 

376 

2 10 

500 

FTOT  = FTOT  + 1 

SFREG 

3 77 

21  1 

• ««**«**»(**««**«****«**«****t*X*t*****«********«**«*«[* 

SFREQ 

378 

2 12 

t 

CHECK  IF  ARRAY  SIZE  EXCEEDED 

SFREQ 

379 

213 

ttttttt***ttttt*Xt****1Mlir«Att«t*t*At******t**ttlkttAt*t* 

SFREQ 

380 

214 

IF(  FTOT.EQ.FMAX)  THEN 

SFREQ 

3 8 1 

215 

PRINT  *,  'MAXIMUM  NUMBER  OF  DATA  LINES  CANNOT  ' 

SFREQ 

382 

2 1 6 

PRINT  *,  'EXCEED  ',  FMAX,  '.  INSERTION  NOT  POSSIBLE.' 

SFREG 

3 33 

217 

CO  TO  10 

SFREQ 

384 

2 18 

END  IF 

SFREQ 

385 

219 

ttttttAAA*tttttAAA*AA**AAA«*******A**A*«AA*A*«A*x*A*A** 

SFREQ 

386 

220 

CALL  DATAIN  (O.FTOT) 

SFREQ 

387 

22  1 

510 

PRINT* 

SFREQ 

3 8 8 

222 

PRINT*,  'DO  YOU  WANT  TO  ENTER  MORE  DATA?  (1)  YES 

!2) 

NO' 

SFREQ 

3 89 

223 

PRINT*,  ' ENTER  A NUMBER  !!!' 

SFREQ 

390 

224 

REWIND  1 

SFREQ 

391 

225 

READ! 1 , * , END=5 1 0)  ANSWER 

SFREQ 

392 

226 

t 

SFREQ 

3 93 

227 

* * * 

CHECK  VALIDITY  OF  NUMBER 

SFREQ 

394 

223 

IF  ! ! ANSWER  .NE.  1 > .AND.  ! ANSWER  NE.  2 ) ) THEN 

SFREQ 

3 95 

229 

GOTO  510 

SFREQ 

396 

230 

A 

SFREQ 

3 97 

23  1 

AAA 

ENTER  MORE  DATA 

SFREQ 

398 

232 

ELSE  IF  < ANSWER  .EQ.  1 ) THEN 

SFREQ 

3 99 

233 

GOTO  500 

SFREQ 

400 

234 

A 

SFREQ 

4 0! 

235 

AAA 

DISCONTINUE  DATA  ENTRY 

SFREQ 

402 

236 

ELSE  IF  ! ANSWER  .EQ.  2 ) THEN 

SFREQ 

403 

237 

PRINT* 

SFREQ 

404 

238 

PRINT*,  'DATA  ENTRY  DISCONTINUED' 

SFREQ 

405 

239 

A 

SFREQ 

406 

240 

END  IF 

SFREQ 

407 

24  1 

END  IF 

SFREQ 

408 

242 

A 

SFREQ 

4 09 

243 

A-- 

SFREQ 

410 

244 

AAA 

STORE  DATA  AND  PROGRAM  *** 

SFREQ 

4 1 1 

245 

A 

SFREQ 

4 1 2 

246 

IF  ! COMMAND  .EQ.  6 ) THEN 

SFREQ 

4 1 3 

247 

600  PRINT* 

SFREQ 

•1  A i 

248 

PRINT* , 'DOUBLE  CHECK  ! ! ! ' 

SFREQ 

4 15 

249 

PRINT*,  ' DO  YOU  YOU  WANT  TO  STORE  THIS  DATA  AND 

END 

PROG  ' 

SFREQ 

4 1 6 

250 

PRINT*,  ' NOTE:  STORING  THIS  DATA  WILL  WIPE  OUT  ANY 

OLD 

FILE 

SFREQ 

4 1 ■ 

25  1 

PRINT*,  • OF  THE  SAME  NAME  M!' 

SFREQ 

4 1 8 

252 

PRINT*,  ' ENTER  A NUMBER:  !1)  YES  !2)  NO' 

SFREQ 

4 19 

253 

REWIND  1 

SFREQ 

420 

254 

READ!1 ,*,END=600)  ANSWER 

SFREQ 

421 

255 

A 

SFREQ 

422 

256 

AAA 

SET  FLAG  FOR  STORING  DATA  IN  THE  MAIN  PROGRAM 

SFREQ 

4 23 

197 
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257  IF  ( ANSWER  . EQ . 1 ) THEN 

, SFREQ 

'4  2 4 

258 

QUIT  = 1 

SFREQ 

4 25 

259 

RETURN 

SFREQ 

4 2 6 

260 

* 

SFREQ 

4 27 

26  1 

***  ABORT  'STORING’  MODE 

SFREQ 

428 

262 

ELSE  IF  ( ANSWER  EQ.  2 ) THEN 

SFREQ 

429 

26  3 

PRINT* 

SFREQ 

430 

2 64 

PRINT*,  ' "STORING"  MODE  DISCONTINUED' 

SFREQ 

431 

26  5 

* 

SFREQ 

432 

2 66 

***  CHECK  VALIDITY  OF  ANSWER 

SFREQ 

4 33 

26  7 

ELSE  IF  ( ( ANSWER  NE.  1 ) AND.  ( ANSWER  NE.  2 ) 

) THEN 

SFREQ 

43  4 

268 

GOTO  600 

SFREQ 

4 3 5 

269 

* 

SFREQ 

43  6 

2 70 

END  IF 

SFREQ 

4 37 

27  1 

END  IF 

SFREQ 

4-3  8 

2 72 

* 

SFREQ 

4 39 

273 

- SFREQ 

440 

274 

***  END  PROGRAM  WITHOUT  STORING  DATA  *** 

SFREQ 

441 

275 

- SFREQ 

442 

276 

IF  ( COMMAND  .EQ.  7 ) THEN 

SFREQ 

4 43 

27  7 

700  PRINT* 

SFREQ 

444 

278 

PRINT* , 'DOUBLE  CHECK  ! ! ! ' 

SFREQ 

4 45 

279 

PRINT*,  ' DO  YOU  WANT  TO  END  THIS  PROGRAM  ', 

SFREQ 

446 

280 

+ 'WITHOUT  STORING  DATA?' 

SFREQ 

447 

28  1 

PRINT*,  ' ENTER  A NUMBER:  (1)  YES  (2)  NO' 

SFREQ 

448 

282 

REWIND  1 

SFREQ 

4 ^ ? 

283 

READ( 1 , * ,END=700)  ANSWER 

SFREQ 

450 

284 

* 

SFREQ 

451 

285 

***  SET  FLAG  FOR  ABORTING  PROGRAM  IN  THE  MAIN  PROGRAM 

SFREQ 

452 

286 

IF  ( ANSWER  EQ.  1 ) THEN 

SFREQ 

4 53 

287 

ABORT  = 1 

SFREQ 

45  4 

288 

RETURN 

SFREQ 

4 55 

289 

* 

SFREQ 

456 

290 

***  ABORT  'STORING'  MODE 

SFREQ 

457 

29  1 

ELSE  IF  { ANSWER  . EQ . 2 ) THEN 

SFREQ 

458 

292 

PRINT* 

SFREQ 

45? 

293 

PRINT*,  ' "ABORTION"  MODE  DISCONTINUED' 

SFREQ 

460 

294 

* 

SFREQ 

461 

295 

***  CHECK  VALIDITY  OF  ANSWER 

SFREQ 

462 

296 

ELSE  IF  ( ( ANSWER  .NE.  1 ) AND.  ( ANSWER  . NE . 2 > 

> THEN 

SFREQ 

463 

297 

GOTO  700 

SFREQ 

464 

298 

* 

SFREQ 

465 

29  9 

END  IF 

SFREQ 

466 

300 

END  IF 

SFREQ 

467 

30  1 

* 

SFREQ 

468 

302 

- SFREQ 

469 

30  3 

***  LOOP  TO  BEGINNING  OF  'MANIP'  SUBROUTINE 

SFREQ 

470 

304 

- SFREQ 

471 

305 

GOTO  10 

SFREQ 

472 

306 

* 

SFREQ 

473 

307 

END 

SFREQ 

474 

VARIABLE 

MAP-- 

(LO=A) 

NAME ADDRESS 

--BLOCK 

-PROPERTIES 

TYPE  --• 

ABORT 

2 

DUMMY-ARG 

INTEGER 

AFLAG 

2B 

/ INITILN/ 

REAL 

ANSWER 

1 36  4B 

INTEGER 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

COMMAND 

1 3 7 0B 

INTEGER 

DIR 

NONE 

UNUSED/ 

*s* 

CHAR*3 

DOK 

NONE 

UNUSED/ 

*s* 

INTEGER 

FERR 

66B 

/ INITILN/ 

INTEGER 

198 
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FLACl 

1 365B 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

PROM 

NONE 

UNUSED/ *S* 

CHAR*3 

FTOT 

47B 

INITILN/ 

INTEGER 

INSERT 

NONE 

UNUSED/*S* 

INTEGER 

LOK 

NONE 

UNUSED/*S* 

INTEGER 

N 

1 346B 

INTEGER 

NOK 

NONE 

UNUSED/ *5* 

INTEGER 

OK 

NONE 

UNUSED/*S* 

INTEGER 

OKI 

NONE 

UNUSED/*S* 

INTEGER 

OK2 

NONE 

UNUSED/ «S* 

INTEGER 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

QUIT 

1 

DUMMY-ARG 

INTEGER 

RFLAG 

3B 

/ INITILN/ 

REAL 

TEMP 

NONE 

UNUSED/ *S* 

INTEGER 

TO 

NONE 

UNUSED/*S* 

CHAR*3 

V 

NONE 

UNUSED/*S* 

INTEGER 

X 

1367B 

INTEGER 

Y 

NONE 

UNUSED/ *S* 

INTEGER 

50 


-SYMBOLIC  CONSTANTS--(LO=A) 

-NAME TYPE VALUE 


FMAX  INTEGER 


50 


-PROCEDURES--(LO=A) 
-NAME TYPE 

DATA  IN 
DISPLAY 


ARCS CLASS 

2 SUBROUTINE 

2 SUBROUTINE 


-STATEMENT  LABELS-- ( LO=A) 


LABEL-ADDRESS  --- 

--PROPERTIES- 

---DEF 

-LABEL 

-ADDRESS  - ■ 

- PROPERTIES- 

---DEF 

10  7B 

19 

305 

32  5B 

1 48 

100  50B 

45 

330 

INACTIVE 

DO-TERM 

174 

200  133B 

85 

500 

41  3B 

2 10 

210  *NO  REFS* 

1 1 8 

510 

42  7B 

22  1 

230  INACTIVE 

DO-TERM 

119 

400 

47  0B 

247 

300  254B 

144 

700 

5 4 2B 

277 

-ENTRY  POINTS-- (LO=A) 
-NAME ADDRESS --ARGS 

MAN  IP  5B  2 


-I/O  UNITS--(LO=A) 
-NAME---  PROPERTIES 

TAPEl  PMT/SEQ 


FTN  5.1+552  83/12/20.  11.52  59  PACE  13 

SUBROUTINE  MANIP  74/175  OPT=0 


--STATISTICS-- 


PROGRAM-UNIT  LENGTH 

1 3 7 5B 

r 745 

CM  LABELLED  COMMON  LENGTH 

7 IB 

= 57 

CM  STORAGE  USED 

43000B 

< 24112 

COMPILE  TIME 

0 4 04 

SECONDS 

199 
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1 SUBROUTINE  DISPLAY  (LINE,  COMMAND)  SFREQ  475 


2 

*COMF 

1 

3 

***  COMMON  FOR  INITIAL  PARAMETERS 

K * 

*COMF 

1 

4 

*COMF 

0 

5 

INTEGER  FMAX 

COMF 

4 

f> 

PARAMETER  (FMAX  = 50) 

COMF 

5 

7 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX), 

FERR  , 

COMF 

6 

8 

$ FTOT 

COMF 

7 

9 

COMMON  /IMITILC/  BLDG 

COMF 

8 

1 0 

CHARACTER  * 5 BLDG 

COMF 

9 

1 1 

REAL  FREQ,  AFLAC,  RFLAG,  FREQA 

COMF 

10 

1 2 

INTEGER  QUALITY,  FERR,  FTOT 

COMF 

1 1 

13 

*COMF 

1 2 

14 

*COMF 

1 3 

15 

INTEGER  LINE,  COMMAND,  N 

SFREQ 

477 

U 

1000  FORMAT  ( 1 X , ‘ L I NE  # FREQUENCY  (HZ)') 

SFREQ 

4 78 

17 

20  00  FORMAT  ( 4 X , I 3 , 8 X , 1 P E 1 5 . 5 ) 

SFREQ 

479 

1 8 

PRINT  1000 

SFREQ 

4 80 

19 

IF  ( COMMAND  . EQ . 4 ) THEN 

SFREQ 

48  1 

20 

DO  10  N = 1 , FTOT 

SFREQ 

482 

21 

PRINT  2000,  N,FREQA(N) 

SFREQ 

483 

22 

10  CONTINUE 

SFREQ 

4 84 

23 

ELSE 

SFREQ 

485 

24 

PRINT  2000,  LINE , FREQA(LINE) 

SFREQ 

486 

25 

END  IF 

SFREQ 

487 

26 

RETURN 

SFREQ 

4 88 

27 

END 

SFREQ 

489 

--VARIABLE  MAP--(LO=A) 


NAME 

ADDRESS- 

-BLOCK PROPERTIES 

TYPE--- 

AFLAC 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

COMMAND 

2 

DUMMY-ARG 

INTEGER 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

FTOT 

67B 

/ INITILN/ 

INTEGER 

LINE 

1 

DUMMY-ARG 

INTEGER 

N 

lOOB 

INTEGER 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

RFLAG 

3B 

/ INITILN/ 

REAL 

--SYMBOLIC  CONSTANTS--(LO=A) 

-NAME TYPE- VALUE 


FMAX  INTEGER 


50 


FTN  5 . 1 + 5 5 2 83  / 1 2 / 2 0 . 1 1.52 

SUBROUTINE  DISPLAY  74/175  OPT=0 


59  PAGE 


15 


--STATEMENT  LABELS-- ( LO=A ) 

-LAB  EL -ADDRESS PROPERTIES DEF 


--ENTRY  POINTS--(LO=A) 
-NAME ADDRESS-- ARCS 


10 

INACTIVE 

DO-TERM 

22 

1000 

51B 

FORMAT 

16 

2000 

56B 

FORMAT 

17 

DISPLAY  5B  2 

--STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


104B  = &8 

71B  = 57 

61000B  = 25088 

0.045  SECONDS 
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FUNCTION  VA:  74/175  OPT=0 


1 

INTEGER  FUNCTION  VAL(STRING) 

3FREQ 

4? 

2 C»* 

RETURNS  THE  INTEGER  VALUE  OF  A STRING. 

SFREG 

49 

3 

INTEGER  NUMBER,  I , L , EXP , D I G I T , GETLEN 

SFREQ 

49 

4 

CHARACTER  * (*)  STRING 

S FR  E Q 

4? 

5 

L = GETLEN(STRING) 

SFREQ 

49 

6 

NUMBER  = 0 

SFREQ 

49 

7 

DO  10  X = L,  1 , -1 

SFREQ 

4 ? 

8 

EXP  = L - X 

SFREQ 

49 

9 

DIGIT  = ICHAR(STRING(X: X) ) - 16 

SFREQ 

49 

10 

NUMBER  = NUMBER  + D I G I T* 1 0 * * E XP 

SFREQ 

4 9 

11  10 

CONTINUE 

SFREQ 

50 

12 

VAL  = NUMBER 

SFREQ 

50 

13 

RETURN 

SFREQ 

5 0 

1 4 

END 

SFREQ 

5 0 

-VARIABLE  MAP--(LO=A) 

-NAME ---ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


DIGIT 

76B 

INTEGER 

EXP 

75B 

INTEGER 

L 

74B 

INTEGER 

NUMBER 

72B 

INTEGER 

STRING 

1 DUMMY-ARG 

CHAR* ( *) 

VAL 

71B 

INTEGER 

X 

73B 

INTEGER 

-PROCEDURES--(LO=A> 

-NAME TYPE ARCS CLASS 

GETLEN  INTEGER  1 FUNCTION 

ICHAR  INTEGER  1 INTRINSIC 


-STATEMENT  LABELS-- ( LO=A ) 

-LAB  EL -ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  11 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS- -ARCS 

VAL  6B  1 


-STATISTICS-- 

PROGRAM-UNIT  LENGTH  102B  = 66 

CM  STORAGE  USED  61000B  = 25088 

COMPILE  TIME  0.039  SECONDS 


' G 

1 

2 

3 

4 

5 

6 

7 

8 

9 

0 

2 
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FTN  5 . 1+552 

FUNCTION  GETLEN 


1 

INTEGER  FUNCTION  GETLEN  (STRING) 

SFREQ 

504 

2 

C 

SFREQ 

5 05 

3 

C 

DETERMINE  LENGTH  OF  STRING  EXCLUDING  ANY  BLANK  PADDING 

SFREQ 

506 

4 

C 

SFREQ 

507 

5 

c 

SFREQ 

508 

6 

c 

ARGUMENT  DEFINITIONS  -- 

SFREQ 

5 09 

7 

c 

READ  ARGUMENTS 

SFREQ 

5 1 0 

8 

c 

STRING  - STRING  WHOSE  LENGTH  IS  TO  BE  DETERMINED 

SFREQ 

5 11 

9 

c 

SFREQ 

5 1 2 

10 

CHARACTER  * (*)  STRING 

SFREQ 

5 13 

1 1 

c 

SFREQ 

514 

12 

c 

FUNCTION  PARAMETERS 

SFREQ 

5 15 

13 

CHARACTER  * 1 BLANK 

SFREQ 

5 1 6 

1 4 

PARAMETER  ( BLANK  = ' ' ) 

SFREQ 

5 17 

15 

c 

SFREQ 

5 1 8 

U 

c 

LOCAL  VARIABLES 

SFREQ 

5 19 

17 

INTEGER  NEXT 

SFREQ 

5 2 0 

18 

c 

SFREQ 

521 

19 

c 

START  WITH  THE  LAST  CHARACTER  AND  FIND  THE  FIRST  NON-BLANK 

SFREQ 

522 

20 

DO  10  NEXT  = LEN(STRING) , 1 , -1 

SFREQ 

523 

21 

IF  (STRINGINEXT  : NEXT)  . NE . BLANK)  THEN 

SFREQ 

524 

22 

GETLEN  = NEXT 

SFREQ 

525 

23 

RETURN 

SFREQ 

526 

24 

END  IF 

SFREQ 

527 

25 

10  CONTINUE 

SFREQ 

528 

26 

c 

SFREQ 

529 

27 

c 

ALL  CHARACTERS  ARE  BLANKS 

SFREQ 

530 

28 

GETLEN  = 0 

SFREQ 

531 

29 

c 

SFREQ 

532 

30 

RETURN 

SFREQ 

533 

31 

END 

SFREQ 

534 

-VARIABLE  MAP--(LO=A) 

-NAME ---ADDRESS- -BLOCK PROPERTIES --TYPE SIZE 

GETLEN  63B  INTEGER 

NEXT  68B  INTEGER 

STRING  1 DUMMY-ARG  CHAR*(*) 


-SYMBOLIC  CONSTANTS--(LO=A) 

-NAME TYPE - VALUE 

BLANK  CHAR*1  ' ’ 


-PROCEDURES--(LO=A) 

-NAME TYPE- -ARGS CLASS 

LEN  INTEGER  1 INTRINSIC 


-STATEMENT  LABELS-- ( LO=A ) 

-LAB EL -ADDRESS PROPERTI  ES DEF 

10  INACTIVE  DO-TERM  25 
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FUNCTION  GETLEN  74/175  OPT=0 

--ENTRY  POINTS--(LO=A) 

-NAME ADDRESS- -ARGS 

GETLEN  6B  1 


--STATISTICS-- 

70B  = 56 

61000B  = 25088 

0.039  SECONDS 


PROGRAM-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


fTN  5 U552 
SUBROUTINE  LFREQ 


i3ll2l2Q  11.52.59  PAGE 
7<1/175  OPT  = 0 


19 


1 SUBROUTINE  LFREQ  LFREQ  1 

2 * ' M M !!!!!!!  M I !!!!  I !!!!!!!!!!  MM!  M !!!!!!!!!!!!!!!!!!!!  I ! M.  H ! M !!  M ! L F R E Q 2 

3 « I I I M I LFREQ  3 

9 •''!  LOAD  THE  CONTENTS  OF  THE  FILE  'BXXXIXF'  INTO  ARRAYS  FREQA . LFREQ  4 

5 • I i|  I M LFREQ  5 

i t I I I I II  ! M II  II  M I II  I!  M.  I I M.  M II  M II  M I!  ! M I!  M II  ! II  I!  II  I!  ! II  I!  II  ! I!  I ! M ! L F R E Q 6 

g •»»*«»»»«»«»«*»»***********************»***********»***********»****»***COMF  1 

9 ***  COMMON  FOR  INITIAL  PARAMETERS  ***COMF  2 

10  **it**i)«([«*«i***ti***«»i****«*******«*««*«********«*«***«*****i«**)init**«(***it*«C0MF  3 


1 1 

INTEGER  FMAX 

COMF 

4 

12 

PARAMETER  (FMAX  = 50) 

COMF 

e 

13 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR, 

COMF 

6 

1 4 

$ FTOT 

COMF 

7 

15 

COMMON  /INITILC/  BLDG 

COMF 

8 

1 6 

CHARACTER  * 5 BLDG 

COMF 

9 

17 

REAL  FREQ,  AFLAG,  RFLAG,  FREQA 

COMF 

10 

1 8 

INTEGER  QUALITY,  FERR,  FTOT 

COMF 

1 1 

19 

1 1 1 1 t tt  It  1 1 1 1 1 1 1 1 1 1 1 It  1 1 1 1 1 1 H t 1 1 1 1 t 1 1 1 1 H * 1 1 1 1 1 1 1 1 1 * 1 1 1 1(  * * t k * t It  * 1 1 t H 1 1 

12 

20 

t It  1 1 n n 1 1 1 it  It  It  1 1 1 1 h t It  t It  It  1 1 it  1 1 h It  It  It  t It  It  It  t it  It  it  t tt  1 1 It  1 1 it  t t tit  it  fk*  1 1 1 it  It  It  t it  It  it  t it  * 1 1 K 

13 

21 

LFREQ 

9 

22 

A 

DECLARATION  OF  VARIABLES 

LFREQ 

10 

23 

AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 

LFREQ 

1 1 

24 

INTEGER  GETLEN,  R,  C 

LFREQ 

12 

25 

CHARACTER  * 7 NAME,  PFN 

LFREQ 

1 3 

26 

AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 

LFREQ 

14 

27 

* 

LFREQ 

15 

28 

AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA 

LFREQ 

16 

29 

NAME  = 'B ’ //BLDG<  1 : GETLEN(BLDG) ) / / ' F ' 

LFREQ 

17 

30 

PFN  = NAME  (1  GETLEN(NAME) ) 

LFREQ 

18 

31 

FERR  = 0 

LFREQ 

19 

32 

CALL  PF  ( 'GET* ,0,PFN(1 ;GETLEN(PFN) ), 'RC , FERR) 

LFREQ 

20 

33 

IF  ( FERR  EQ.  0 ) THEN 

LFREQ 

21 

34 

OPEN  (UNIT=3,  FILE=PFN,  FORM= ' FORMATTED ’ , 

LFREQ 

22 

35 

S STATUS= 'OLD' , ACCESS= ' SEQUENTIAL ' ) 

LFREQ 

23 

36 

FTOT  = 0 

LFREQ 

24 

37 

DO  10  R = 1,FMAX 

LFREQ 

25 

38 

READ  (3 , 1000 ,END=20)  FREQA(R) 

LFREQ 

26 

39 

1 00  0 FORMAT! El  2. 7) 

LFREQ 

27 

40 

FTOT  = FTOT  + 1 

LFREQ 

28 

41 

10 

CONTINUE 

LFREQ 

29 

42 

20 

CONTINUE 

LFREQ 

30 

43 

CLOSE(3,STATUS='DELETE' ) 

LFREQ 

31 

44 

ELSE  IF  ( FERR  EQ.  2 > THEN 

LFREQ 

32 

45 

CALL  WARNING  (11) 

LFREQ 

33 

46 

ELSE 

LFREQ 

34 

47 

CALL  WARNING  (12) 

LFREQ 

35 

48 

END  IF 

LFREQ 

36 

49 

RETURN 

LFREQ 

37 

50 

END 

LFREQ 

38 

--VARIABLE  MAP--(LO=A) 


NAME-- 

-ADDRESS- 

-BLOCK 

-PROPERTIES 

--  -TYPE 

---SIZE 

AFLAG 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

C 

NONE 

UNUSED/ *S» 

INTEGER 

FERR 

66B 

/INITILN/ 

INTEGER 

FREQ 

06 

/ INITILN/ 

REAL 

FREQA 

46 

/ INITILN/ 

REAL 

50 

FTOT 

67B 

/ INITILN/ 

INTEGER 

NAME 

21  OB 

CHAR*7 

PFN 

21  IB 

CHAR*7 
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SUBROUTINE  LFREQ  74/175  OPT=0 


INTEGER 

INTEGER 

REAL 


--SYMBOLIC  CONSTANTS-- ( LO=A) 


-NAME TYPE VALUE 

FMAX  INTEGER  50 


QUALITY  IB  /INITILN/ 

R 20  7B 

RFLAG  3B  /INITILN/ 


--PROCEDURES--(LO=A) 
-NAME TYPE 

GETLEN  INTEGER 

PF 

WARNING 


ARGS CLASS 

1 FUNCTION 

5 SUBROUTINE 

1 SUBROUTINE 


--STATEMENT  LABELS-- ( LO=A ) 


-LABEL- 

ADDRESS 

--PROPERTIES- 

---DEF 

10 

INACTIVE 

DO-TERM 

41 

20 

63B 

42 

1000 

1 20B 

FORMAT 

39 

--ENTRY  POINTS--(LO=A) 
-NAME-- - ADDRESS-- ARGS- -- 

LFREQ  5B  0 


--I/O  UNITS--(LO=A) 
-NAME---  PROPERTIES- 

TAPE3  AUX/FMT/SEQ 


--STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


215B  = 141 

7 IB  = 57 

61000B  = 25088 

0.080  SECONDS 
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SUBROUTINE  ERROR  74/175  OPT=0 

1 SUBROUTINE  ERROR! lERR)  ERROR  1 

2 CHARACTER»45  MESSAGE(20)  ERROR  2 


3 

DATA 

MESSAGE!  1)/ 

'MATERIALS 

DATA 

, BASE 

IS  EMPTY 

' / 

ERROR 

3 

4 

DATA 

MESSAGE!  2)1 

' FREQUENCY 

IS  OUT  i 

OF 

RANGE 

' / 

ERROR 

4 

5 

DATA 

MESSAGE!  3)/ 

'THIS 

MATERIAL 

IS  ; 

NOT 

IN  DATA  BASE 

' / 

ERROR 

5 

6 

DATA 

MESSAGE!  4)/ 

'DENOMINATOR  IS 

1 ZERO 

' / 

ERROR 

6 

7 

DATA 

MESSAGE!  5)/ 

'FILE 

HANDLING 

ERROR 

' / 

ERROR 

7 

8 

DATA 

MESSAGE!  6)/ 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

8 

9 

DATA 

MESSAGE!  7)1 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

9 

1 0 

DATA 

MESSAGE!  8)/ 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

10 

1 1 

DATA 

MESSAGE!  7)1 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

1 1 

1 2 

DATA 

MESSAGE!  10)/ 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

12 

13 

DATA 

MESSAGE  ! 1 1 ) / 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

13 

1 4 

DATA 

MESSAGE!  12)  / 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

14 

15 

DATA 

MESSAGE!  13  ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

15 

1 6 

DATA 

MESSAGE!  14)  / 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

16 

17 

DATA 

MESSAGE!  15  ) / 

’ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

1 7 

1 8 

DATA 

MESSAGE!  16  ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

18 

19 

DATA 

MESSAGE  ! 1 7 ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

’ / 

ERROR 

19 

20 

DATA 

MESSAGE!  18)  / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

20 

21 

DATA 

MESSAGE  ! 19  ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

21 

22 

DATA 

MESSAGE ! 20 ) / 

' ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

22 

23 

IERRM=5 

ERROR 

23 

24 

IF ( lERR . GT . lERRM) 

IERR  = 

20 

ERROR 

24 

25 

WRITE(6,10)  lERR, 

MESSAGE! lERR) 

ERROR 

25 

26  10 

FORMAT!'  ***ERROR 

NUMBER  = ■ 

,15, 

‘ * Ht  * 

' , A45 ) 

ERROR 

26 

27 

CALL 

PMDSTOP 

ERROR 

27 

28 

STOP 

■ ERROR  ' 

ERROR 

28 

29 

END 

ERROR 

29 

-VARIABLE  MAP--(LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 

lERR  1 DUMMY-ARG  INTEGER 

lERRM  210B  INTEGER 

MESSAGE  56B  CHAR*45  20 


-PROCEDURES--(LO=A) 

-NAME TYPE ARCS CLASS 

PMDSTOP  0 SUBROUTINE 


-STATEMENT  LABELS-- < LO=A ) 

-LAB  EL -ADDRESS PROPERTIES DEF 

10  36B  FORMAT  26 
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SUBROUTINE  ERROR  74/175  OPT=0 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS-- ARCS 

ERROR  5B  1 


--I/O  UNITS--(LO=A) 
-NAME PROPERTIES 

TAPE6  FMT/SEQ 


--STATISTICS-- 

PROGRAM-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


2 1 3B  2 139 

6 1 OOOB  1 2 5 0 8 8 

0 056  SECONDS 
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SUBROUTINE  WARNING  74/175  OPT=0 


23 


1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
12 

13 

14 

15 


26 

27 

28 

29 

30 

31 

32 

33 


10 

20 


SUBROUTINE  VARNING(ERR) 
INTEGER  ERR,  ERRM 
CHARACTER*45  MESSAGE(20) 


DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 

DATA 


MESSAGE! 
MESSAGE ( 
MESSAGE! 
MESSAGE! 
MESSAGE! 
MESSAGE ! 
MESSAGE! 
MESSAGE ! 
MESSAGE! 
MESSAGE!  10  ) / 
MESSAGE! 11  )/ 


1 ) / 
2 ) / 
3)  / 

4 ) / 

5 ) / 

6 ) / 


"HOLE"  DATA  FILE  DOES  NOT  EXIST  FOR  THIS  BLDG 
FILE  HANDLING  PROBLEM  ON  "HOLE"  DATA  FILE 
"MATTER"  FILE  DOES  NOT  EXIST  FOR  THIS  BLDG 
FILE  HANDLING  PROBLEM  ON  "MATTER  FILE 

NOT 
ON 
NOT 
ON 


"TYPE"  DATA  FILE  DOES 
FILE  HANDLING  PROBLEM 

7) / '"WALL"  DATA  FILE  DOES 

8)  /‘FILE  HANDLING  PROBLEM 
HEIGHT  AND  WIDTH  OF  ROOM  MISSING 
LENGTH  OF  ROOM  IS  MISSING 
FREQ  FILE  DOES  NOT  EXIST  FOR  THIS 


EXIST 

"TYPE" 

EXIST 

"WALL" 


FOR  THIS 
FILE 

FOR  THIS 
FILE 


BLDG 


BLDG 


9 ) / 


BLDG 


MESSAGE!12) / 'FILE  HANDLING  PROBLEM  WITH  FREQ  FILE 


1 6 

DATA 

MESSAGE! 13 ) / ‘WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

17 

DATA 

MESSAGE! 14 ) / 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

1 8 

DATA 

MESSAGE! 15 ) / 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

19 

DATA 

MESSAGE ! Id ) / 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

20 

DATA 

MESSAGE! 17 ) / 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

21 

DATA 

MESSAGE! 18) / 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

22 

DATA 

MESSAGE! 19 ) / 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

23 

DATA 

MESSAGE ! 20 ) / 'WARNING 

CODE 

IS 

OUT 

OF 

RANGE 

24 

ERRM= 

:12 

25 

I ERR 

= ERR 

IF !ERR . GT. ERRM)  IERR=2Q 
WRITE ! 6 , 20 ) 

WRITE!6,10>  ERR, MESSAGE! lERR) 
WRITE!6,20) 

FORMAT!'  ***WARNING  NUMBER  = 
FORMAT! ' ' ) 

RETURN 

END 


15 


,A45  ) 


WARNING 

1 

WARNING 

7 

WARNING 

3 

' / 

WARNING 

4 

' / 

WARNING 

c 

' / 

WARNING 

6 

' / 

WARNING 

7 

' / 

WARNING 

8 

' / 

WARNING 

0 

' / 

WARNING 

10 

' / 

WARNING 

1 1 

' / 

WARNING 

12 

' / 

WARNING 

1 3 

' / 

WARNING 

1 4 

' / 

WARNING 

15 

' / 

WARNING 

16 

' / 

WARNING 

1 7 

' / 

WARNING 

18 

' / 

WARNING 

1 9 

' / 

WARNING 

20 

' / 

WARNING 

21 

' / 

WARNING 

22 

' / 

WARNING 

23 

WARNING 

24 

WARNING 

25 

WARNING 

26 

WARNING 

2 '/ 

WARNING 

28 

WARNING 

29 

WARNING 

30 

WARNING 

31 

WARNING 

32 

WARNING 

33 

-VARIABLE  MAP--!LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


ERR 

1 DUMMY-ARG 

ERRM 

606 

lERR 

213B 

MESSAGE 

61B 

INTEGER 

INTEGER 

INTEGER 

CHAR*45  20 


-STATEMENT  LABELS-- ! LO=A) 

-LAB  EL -ADDRESS PROPERTIES DEF 

10  34B  FORMAT  30 

20  42B  FORMAT  31 


-ENTRY  P01NTS--!LO=A) 
-NAME ADDRESS--ARGS 

WARNING  5B  1 
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SUBROUTINE  WARNING  74/175  OPT=0 

--I/O  UNITS-- ! LO=A ) 

-NAME---  PROPERTIES 

TAPE6  FMT/SEQ 


--STATISTICS-- 

PROGRAM-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


216E  = 142 

61000B  = 25088 

0.064  SECONDS 
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PROGRAM  MASTER  74/175  OPT=0 


1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
11 
1 2 
13 
1 4 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


PROGRAM  MASTER  ( I NPUT , OUTPUT , TAPEl  = INPUT, TAPE6  = OUTPUT) 


»*H**<f*********<t******H' 

AAAI 

***  COMMON  FOR  INITIAL  PARAMETERS 
* * * ; 

INTEGER  FMAX 
PARAMETER  (FMAX  = 50) 

COMMON  /INITILN/  FREQ,  QUALITY 
5 FTOT 

COMMON  /INITILC/  BLDG 
CHARACTER  * 5 BLDG 
REAL  FREQ,  AFLAG,  RFLAG,  FREQA 
INTEGER  QUALITY,  FERR,  FTOT 


MASTER 
I************* master 

I********  * COMF 
***COMF 


AFLAG,  RFLAG,  FREQA(FMAX),  FERR 


COMF 
COMF 
COMF 
COMF 
COMF 
COMF 
COMF 
COMF 
**********  *COMF 


COMMON  FOR  DATABASE  OF  WALL  PARAMETERS 


***COMV 


INTEGER  WMAX 
PARAMETER  (WMAX  = 75) 

COMMON  /WALLN/  WDIM(WMAX,3) 
COMMON  /WALLC/  WALL(WMAX,4) 
INTEGER  WTOT,WERR 
REAL  WDIM 
CHARACTER  *3  WALL 
* ===============================; 

**  DESCRIPTION  OF  ARRAYS 
* ===============================: 

* WALL  IDENTIFICATION 

* 

« 

* 

* 

* 

* 

* 

* 

* 


WTOT,  WERR 


DIRECTION 

FROM 

ROOM 

TO 

ROOM 

WALL (X , 1 ) 
A3 

WALL(X ,2) 
A3 

WALL(X,3) 

A3 

WALL  PARAMETERS 

MATERIAL 

HEIGHT 

WIDTH 

LAYER  THICKNESS 

WALL( X, 4) 

WDIM( X, 1 ) 

WDIM( X, 2) 

WDIM(X, 3) 

A3 

F8  . 2 

F8  . 2 

F8  , 2 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 


* * ) 

***  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS 

*******  1 


***COMT 


INTEGER  TMAX 
PARAMETER  (TMAX=35) 

COMMON  /TYPEN/TDIM(TMAX , 4) ,TTOT ,TDB2 (TMAX ,2) ,TDBTOT,TERR 
COMMON  /TYPEC/TYPE(TMAX,3) ,TDB1 (TMAX) 

INTEGER  TTOT,TDBTOT,TERR 
REAL  TDIM,TDB2 
CHARACTER  * 3 TYPE,TDB1 

* DESCRIPTION  OF  ARRAYS 


* ID 

t _ _ _ 

MATERIAL 

FRAME  MATERIAL 

♦TYPE (X  , 1 ) 

TYPE (X  , 2 ) 

TYPE(X  , 3) 

* A3 

A3 

A3 

« HEIGHT 
* 

WIDTH 

LAYER  DISTANCE 

THICKNESS  ABOVE  FLOOR 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 

COMT 


1 

2 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 
13 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

I 4 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 
29 

1 

2 

3 

4 

5 

6 

7 

8 
9 

iO 

I I 
12 

13 

14 

15 

16 

17 

18 

19 

20 
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6S 

46 

67 

68 
67 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 
81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
100 
10  1 
102 

103 

104 

105 

106 

107 

108 

109 

110 
11  1 
112 

113 

114 

115 

116 

117 

118 

119 

120 
121 
122 

123 

124 

125 

126 

127 

128 


TD1M(X 

1)  TDIM(X,2) 

TDIM(X , 3) 

TDIM(X,4) 

FB  . 2 

F8  . 2 

F8  . 2 

F8  . 2 

ID 

ATTENUATION 

AREA 

COMT 
COMT 
COMT 
COMT 
COMT 
COMT 

TDBKX)  TDB2(X,1)  TDB2(X,2)  COMT 

A3  E9.3  E9.3  COMT 

it*t**tit«** 

**«****«** 

««*****t*****it****************************************«***)«***********c  OMH 

• COMMON  FOR  DATABASE  OF  LOCATIONS  OF  DOORS  AND  WINDOWS  ***COMH 

1 1 * 1 1 * * 


INTEGER  HMAX 
PARAMETER  (HMAX  = 35) 

COMMON  /HOLEN/  HTOT,  HERR 
COMMON  /HOLEC/  HOLE(HMAX,4) 
INTEGER  HTOT,  HERR 
CHARACTER  » 3 HOLE 

ssssss  = = ss  = sss  = = = = s:  = = = = s = s:  = s = = s: 

DESCRIPTION  OF  ARRAYS 
ROOM  IDENTIFICATION 


APERTURE  ID 


DIRECTION 


FROM  ROOM 


TO  ROOM 


HOLE(X, 2) 
A3 


HOLECX, 3) 
A3 


HOLE(X, 4) 
A3 


COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 


HOLE( X, 1 ) 

A3 

******** 

* * * * 

« 

»»  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  *»*COMR 

***t**ii*ttt**t*t*tt*iit**iitiit***tttt*tiitiit**t*t****t***t**t*iit*tt*t*t*t  * COMR 


INTEGER  RMAX 
PARAMETER  (RMAX  = 20) 
COMMON  /ROOMN/  ROOM (RMAX 
INTEGER  NROOMS 
REAL  ROOM 


+ 6,  RMAX  +6),  NROOMS,  RAREA(RMAX) 


COMR 

COMR 

COMR 

COMR 

COMR 


COMMON  FOR  DATABASE  OF  MATERIAL  PROPERTIES 


***COMM 


INTEGER  MMAX  COMM 

PARAMETER  (MMAX=100)  COMM 

COMMON  /MATN/  MATTEN(MMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX),  OR (MMAX),  COMM 
$ MFREQ(MMAX, 7) , MERR,  MTOT  COMM 

COMMON  /MATCZMAT(MMAX) ,MATDESC(MMAX)  COMM 

INTEGER  MTOT,  MERR  COMM 

REAL  MATTEN,  MRCOEF,  MFREQ,  QA , OR  COMM 

CHARACTER  * 3 MAT  COMM 

CHARACTER  * 70  MATDESC  COMM 


COMMON  FOR  EVALUATION  OF  ROOM  MATRIX 


t 
* 

* 

A*************************************************************** 

COMMON  / MAT /TMAT( RMAX, RMAX) , ENERGY ( RMAX ) , POWER! 6) , FT I ME 
+,SWR(RMAX,6) ,IDIR 
REAL  TMAT  , ENERGY , POWER , SWR 
LOGICAL  FTIME 


COMJ 

COMJ 

COMJ 

COMJ 

COMJ 

COMJ 

COMJ 

COMJ 

COMJ 


21 

22 

23 

24 

25 

26 

27 

28 

29 

30 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 

13 

14 

15 

16 

17 

18 

19 

20 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 

13 

14 
1 
2 

3 

4 

5 

6 

7 

8 
9 
1 
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127 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 
1 46 
147 
143 

149 

150 
15  1 

152 

153 

154 

155 

156 

157 

158 

159 

160 
161 
162 

163 

164 

165 

166 

167 

168 

169 

170 
17  1 

172 

173 

174 

175 

176 

177 

178 

179 
1 80 
181 
182 

183 

184 

185 

186 

187 

188 

189 

190 

191 

192 


30 


PRINT* , 
READ! 1 , 
PRINT* , 

PRINT  *. 


i 


* COMMON  FOR  ABSORPTION  AND  REFLECTION  COEFFICIENTS  IN  WALLS 

COMMON  /ROOMD/DDABS(RMAX  + 6,  RMAX  + 6 ) ,DREFL,  DREFLW 
REAL  DDABS  ,DREFL  , DREFLW 


************t1i*1i*1i1i*1i*1rk*****tt1t*1i1it1t*tt*******1i*1i 

* DECLARATION  OF  VARIABLES 

*******«iir****««*ili*«*«*****ik«***«**ltl«*******tt*****it 

INTEGER  GETLEN 

**********1i1i*1i**l!*1i1i*tK1HrK1i*ii1i*»***1iiit*t1t*1tii*****t 

* INITIAL  SETUP 

*iiii**iiii****iiii*****iiiitiiiit*t*ii*i(*****t*ittii**ttt*it**it 

NROOMS  = 3 
AFLAG  = 0 
RFLAG  = 0 

***»*»********»*****i****»»*****»»***t*******»****» 

* INPUT  BUILDING  IDENTIFICATION 

*****1i**liii*l(*ii*lili*tlitii*tttii***tt«t***lt*1i*****tt*li* 

20  PRINT*,  'ENTER  BUILDING  IDENTIFICATION  (E.G.  ''lOl'') 
' (NO  MORE  THAN  5 ALPHANUMERIC  CHARACTERS)' 
* , END  = 20)  BLDG 

■BUILDING  IDENTIFICATION  ENTERED  AS  '■', 

BLDGd  :GETLEN(BLDG)  ) , ' ' ' ' 

■ENTER  NUMBER  OF  ROOMS  IN  BUILDING' 

READ  (1,*,END  = 30)  NROOMS 

t*tiiii*tii**iiiiii***iiii**ii*ii*tiiii*tii*t*****t*t****t*tii*t 

* LOAD  ARRAYS  FROM  DATA  FILES 

«i*«**«****«**lt***«********************t***ik******* 

CALL  LMATTER 
CALL  LWALL 
CALL  LTYPE 
CALL  LHOLE 
CALL  LFREQ 

***mit******1i*1i*1(**1i1ili1itt**li1ilrk1itii**1i*********tt1it 

* CHECK  FOR  ERROR  IN  FREQ  FILE. 

* IF  THERE  IS  AN  ERROR  (E.G.  MISSING)  THEN 

* JUST  USE  THE  DEFAULT  FREQUENCIES 

*****tt**<l****tit1[**4lA**Ilt******«*4lt**1k******It1l(lMllt*<l** 

IF  (FERR.NE.O)  THEN 
FTOT  = 7 
DO  40  IFR  = 1,7 

40  FREQA(IFR)  = 1.0E03  * (10.0  **  IFR) 

PRINT*,  ' ***  DEFAULT  FREQUENCIES  WILL  BE  USED  ***  ' 
END  IF 

iir**lt*<i**<tAltktt***(iltlt*lt*****lHtlk***(**lktt**D**«D*lt*«*lt*lklk*lt*Dlk«* 

CALL  PWALL 
CALL  PHOLE 
CALL  PTYPE 

A*******1k1klt*****1k**ilrA***1t1t**A**A*lt*1k****lk*A*A***A* 

* CHECK  FOR  FILE  ERROR 


) .OR.  ( WERR  .NE.  0 ) OR. 

) .OR.  (TERR  .NE.  0 ) ) THEN 


IF  ( ( MERR  .NE.  0 
5 ( HERR  NE.  0 

CALL  ERROR  (5) 

END  IF 

**t*iiiiiiii*iiiiiiiitiiiiii*ii****iiitiitii*ii**ii********ii*ii*ii*t*t 

* 

DO  200  IFR=  1 , FTOT 
FREQ  = FREQA(IFR) 

CALL  IDDABS 
CALL  LTDB 
CALL  LRAREA 


COMD 

2 

3 

COMD 

4 

COMD 

5 

*COMD 

6 

7 

MASTER 

1 1 

MASTER 

12 

MASTER 

13 

MASTER 

14 

MASTER 

15 

MASTER 

16 

MASTER 

17 

MASTER 

18 

MASTER 

1 9 

MASTER 

20 

MASTER 

21 

MASTER 

22 

MASTER 

23 

MASTER 

24 

MASTER 

25 

MASTER 

26 

MASTER 

27 

MASTER 

28 

MASTER 

29 

MASTER 

30 

MASTER 

31 

MASTER 

32 

MASTER 

33 

MASTER 

34 

MASTER 

35 

MASTER 

36 

MASTER 

37 

MASTER 

38 

MASTER 

39 

MASTER 

40 

MASTER 

41 

MASTER 

42 

MASTER 

43 

MASTER 

44 

MASTER 

45 

MASTER 

46 

MASTER 

47 

MASTER 

48 

MASTER 

49 

MASTER 

50 

MASTER 

51 

MASTER 

52 

MASTER 

53 

MASTER 

54 

MASTER 

55 

MASTER 

56 

MASTER 

57 

MASTER 

MASTER 

59 

MASTER 

60 

MASTER 

61 

MASTER 

62 

MASTER 

63 

MASTER 

64 

MASTER 

65 

MASTER 

66 

MASTER 

67 

MASTER 

68 
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193 

CALL  CFACTOR 

MASTER 

69 

194 

CALL  DFACTOR 

MASTER 

70 

195 

FTIME  = TRUE. 

MASTER 

71 

196 

DO  100  IDIR  =1,5 

MASTER 

72 

197 

DO  SO  J = 1 , 6 

MASTER 

73 

198 

50 

POWER  (J)  = 0.0 

MASTER 

74 

199 

POWER  (IDIR)  = 10.0 

MASTER 

75 

200 

CALL  ECALC 

MASTER 

76 

20  1 

100 

CALL  SPWR 

MASTER 

77 

202 

CALL  PPWR2 

MASTER 

78 

203 

200 

CONTINUE 

MASTER 

79 

204 

STOP 

MASTER 

80 

205 

END 

MASTER 

81 

RIABLE 

MAP 

--(LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


AFLAC 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

DDABS 

OB 

/ROOMD/ 

REAL 

676 

DREFL 

1 244B 

/ROOMD/ 

REAL 

DREFLW 

1 24  5B 

/ROOMD/ 

REAL 

ENERGY 

620B 

/MAT/ 

REAL 

20 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTIME 

6S2B 

/MAT/ 

LOGICAL 

FTOT 

67B 

/ INITILN/ 

INTEGER 

HERR 

IB 

/HOLEN/ 

INTEGER 

HOLE 

OB 

/HOLEC/ 

CHAR»3 

1 40 

HTOT 

OB 

/HOLEN/ 

INTEGER 

IDIR 

1 043B 

/MAT/ 

INTEGER 

IFR 

332B 

INTEGER 

J 

3 3 6B 

INTEGER 

MAT 

OB 

/MATC/ 

CHAR*3 

100 

MATDESC 

36B 

/MATC/ 

CHAR*70 

1 00 

MATTEN 

OB 

/MATN/ 

REAL 

700 

MERR 

4374B 

/MATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

700 

MRCOEF 

1 27  4B 

/MATN/ 

REAL 

700 

MTOT 

4375B 

/MATN/ 

INTEGER 

NROOMS 

1 244B 

/ROOMN/ 

INTEGER 

POWER 

644B 

/MAT/ 

REAL 

6 

QA 

257  0B 

/MATN/ 

REAL 

1 00 

OR 

2734B 

/MATN/ 

REAL 

100 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

RAREA 

1 245B 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

SWR 

65  3B 

/MAT/ 

REAL 

1 20 

TDBTOT 

32  3B 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

1 40 

TERR 

32  4B 

/TYPEN/ 

INTEGER 

TMAT 

OB 

/MAT/ 

REAL 

400 

TTOT 

21  4B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

1 05 

WALL 

OB 

/WALLC/ 

CHAR*3 

300 

WDIM 

OB 

/WALLN/ 

REAL 

225 

WERR 

342B 

/WALLN/ 

INTEGER 

WTOT 

341B 

/WALLN/ 

INTEGER 
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-SYMBOLIC  CONSTANTS--! LO=A) 


NAME-- 

--TYPE 

VALUE 

-NAME- 

---TYPE 

VALUE 

FMAX 

INTEGER 

50 

RMAX 

INTEGER 

20 

HMAX 

INTEGER 

35 

TMAX 

INTEGER 

35 

MM  AX 

INTEGER 

100 

VMAX 

INTEGER 

75 

PROCEDURES--(LO=A) 
NAME TYPE 

--ARGS 

CLASS 

-NAME 

--TYPE 

ARCS--- 

---CLASS 

CFACTOR 

0 

SUBROUTINE 

LRAREA 

0 

SUBROUTINE 

DFACTOR 

0 

SUBROUTINE 

LTDB 

0 

SUBROUTINE 

ECALC 

0 

SUBROUTINE 

LTYPE 

0 

SUBROUTINE 

ERROR 

1 

SUBROUTINE 

LUALL 

0 

SUBROUTINE 

GETLEN  INTEGER 

1 

FUNCTION 

PHOLE 

0 

SUBROUTINE 

IDDABS 

0 

SUBROUTINE 

PPWH2 

0 

SUBROUTINE 

LFREQ 

0 

SUBROUTINE 

PTYPE 

0 

SUBROUTINE 

LHOLE 

0 

SUBROUTINE 

PWALL 

0 

SUBROUTINE 

LMATTER 

0 

SUBROUTINE 

SPWR 

0 

SUBROUTINE 

-STATEMENT  LABELS- -( LO=A ) 


-LABEL- 

ADDRESS 

--PROPERTIES-- 

--DEF 

-LABEL 

-ADDRESS 

--PROPERTIES- 

DEF 

20 

26B 

148 

50 

INACTIVE 

DO-TERM 

1 98 

30 

44B 

153 

100 

INACTIVE 

DO-TERM 

201 

40 

INACTIVE 

DO-TERM 

171 

200 

INACTIVE 

DO-TERM 

203 

-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS-- ARCS- -- 

MASTER  20B  0 


-I  IQ  UNITS--(LO  = A) 
-NAME PROPERTIES 

TAPEl  FMT/SEQ 


-STATISTICS-- 

340B  = 224 

12774B  = 5628 

63000B  = 26112 

0.183  SECONDS 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


212 


FTN  : U55  2 

FUNCTION  ATTEN 


84/03/14.  10.18.23  PAGE 
74/175  OPT=0 


6 


1 REAL  FUNCTION  ATTEN  ( I D , FREQ , AFLAC ) ATTEN 

2 «[[[  t C [[[[[[[[ C C C C [[ C [[[[ C [[[[[[[ t C C [[ C C [ C C C [[[[[ t C C C C C [[[[[ C C C C C t C [[ C C [ ATTEN 

3 "CCC  [[[ATTEN 

4 •[[[  GIVEN  THE  FREQUENCY  AND  THE  MATERIAL,  THIS  FUNCTIQN  RETURNS  [[[ATTEN 

5 *[[[  THE  ATTENUATION  [[[ATTEN 

6 •[[[  [[[ATTEN 

7 •[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [ATTEN 

3 (***«**t**<it**************it*ik*«****************«*«******A****Aitit*******  * ATTEN 
9 » FREQ  IS  IN  HERTZ  ATTEN 

10  * HIFREQ.LOFREQ,  AND  F ARE  IN  LOG  ( HERTZ  ) ATTEN 

11  • AFLAC  RANGES  FROM  0 TO  100  AND  DETERMINES  HOW  MUCH  OF  THE  QUALITY  ATTEN 

12  • FACTOR  IS  APPLIED  TO  THE  ATTENUATION  VALUE.  ATTEN 

15  *«»  COMMON  FOR  DATABASE  OF  MATERIAL  PROPERTIES  *»*COMM 

17  INTEGER  MMAX  COMM 

18  PARAMETER  (MMAX=100)  COMM 

19  COMMON  /MATN/  MATTEN(MMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX),  QR(MMAX),  COMM 

20  S MFREQ(MMAX , 7 ) , MERR,  MTOT  COMM 


21 

COMMON  /MATC/ MAT (MMAX) , MATD ESC (MMAX ) 

COMM 

22 

INTEGER  MTOT,  MERR 

COMM 

23 

REAL  MATTEN,  MRCOEF,  MFREQ,  QA , 

QR 

COMM 

24 

CHARACTER  * 3 MAT 

COMM 

25 

CHARACTER  * 70  MATDESC 

COMM 

26 

27 

ft  ft 

28 

ftft**ftft*ft*ftftft******«ft**ft*ft*ft*ftftft***ft*ft**ftft***ft*«!*** 

ATTEN 

29 

ft 

DECLARATION  OF  VARIABLES 

ATTEN 

30 

ftftft*ftftftftft*ft*ftft**ftft«ft**ft*ft**ft*ft*ft*ft**ft*ft*ft*«ftft*ft**ft 

ATTEN 

31 

REAL  FREQ, FRAC ,MINFREQ,MAXFREQ, LOFREQ, 

HI  FREQ, LOATTEN, HI ATTEN, F 

ATTEN 

32 

INTEGER  R ,C ,RINDEX ,CINDEX 

ATTEN 

33 

LOGICAL  FOUND, EXACT 

ATTEN 

34 

CHARACTER  *3  ID 

ATTEN 

35 

ft  * 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft 

ATTEN 

36 

* 

FIND  ROW  INDEX  OF  MATERIAL 

ATTEN 

37 

ft*ftftftftft*ftfttftftftr*ftftfttftftft*ft*fttftft*ftft*tft*ftftftftftfttftftftftfttt 

ATTEN 

38 

FOUND  = .FALSE. 

ATTEN 

39 

DO  10  R = 1,  MMAX 

ATTEN 

40 

IF  ( MAT(R)  .EQ.  ID  ) THEN 

ATTEN 

41 

FOUND  = .TRUE. 

ATTEN 

42 

RINDEX  = R 

ATTEN 

43 

END  IF 

ATTEN 

44 

10 

CONTINUE 

ATTEN 

45 

IF  ( .NOT.  FOUND  ) THEN 

ATTEN 

46 

I ERR  = 3 

ATTEN 

47 

CALL  ERROR  (lERR) 

ATTEN 

48 

END  IF 

ATTEN 

49 

ftftftft*ftftftft*«*ft*ftft**«*ftftftft****ftft«ft****t*****ft«««**ft* 

ATTEN 

50 

t 

TEST  FOR  FREQUENCY  OUT  OF  RANGE 

ATTEN 

51 

ATTEN 

52 

MINFREQ  = MFREQ  (RINDEX, 1) 

ATTEN 

53 

MAXFREQ  = MFREQ  (RINDEX, 7) 

ATTEN 

54 

IF  ( FREQ  .LT.  MINFREQ  .OR.  FREQ 

. GT. 

MAXFREQ  ) THEN 

ATTEN 

55 

I ERR  = 2 

ATTEN 

56 

CALL  ERROR  (lERR) 

ATTEN 

57 

END  IF 

ATTEN 

58 

ftftfk**t*ft*ftft*ft**ft*t*AftAftftft*ftftftftftftftftftftftftftftft*ftftftftftfkftft 

ATTEN 

59 

ft 

IF  THE  EXACT  FREQUENCY  IS  IN  THE  TABLE, 

THEN 

ATTEN 

60 

ft 

USE  THE  ATTENUATION  VALUE  WITHOUT 

INTERPOLATION. 

ATTEN 

61 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft 

ATTEN 

62 

DO  20  C=  1,7 

ATTEN 

63 

EXACT  = .FALSE. 

ATTEN 

64 

IF  ( FREQ  .EQ.  MFREQ  (RINDEX, C) 

) THEN 

ATTEN 

1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

1 1 

12 

13 

1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

1 4 

15 

U 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 
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65 

EXACT  = .TRUE. 

ATTEN 

66 

CINDEX  r:  C 

ATTEN 

67 

ATTEN  = MATTEN  ( R INDEX , C INDEX ) 

ATTEN 

68 

ATTEN  = ATTEN  * ( 1 + AFLAC  / 100  ) 

ATTEN 

69 

END  IF 

ATTEN 

70 

20 

CONTINUE 

ATTEN 

71 

******ii**t**ti(tti(ii**ii**tiit*****t*t****tt****tittt** 

ATTEN 

72 

INTERPOLATE  ATTENUATION  VALUES  IF  EXACT  FREQUENCY  IS 

ATTEN 

73 

t 

NOT  IN  THE  FREQUENCY/ ATTENUATION  ARRAYS. 

ATTEN 

74 

ATTEN 

75 

IF  ( .NOT.  EXACT  ) THEN 

ATTEN 

76 

DO  30  C = 1 ,6 

ATTEN 

77 

IF  ( FREQ  .GT.  MFREQ  (RINDEX.C)  .AND. 

ATTEN 

78 

5 FREQ  LT.  MFREQ  (RINDEX,C+1)  ) THEN 

ATTEN 

79 

CINDEX  = C 

ATTEN 

80 

END  IF 

ATTEN 

81 

30 

CONTINUE 

ATTEN 

82 

F = ALOGIO  ( FREQ  ) 

ATTEN 

83 

LOFREQ  = ALOGIO  ( MFREQ  (RINDEX,  CINDEX)  ) 

ATTEN 

84 

HIFREQ  = ALOGIO  ( MFREQ  (RINDEX,  CINDEX  + 1)  ) 

ATTEN 

85 

LOATTEN  = MATTEN  (RINDEX , CINDEX) 

ATTEN 

86 

HIATTEN  = MATTEN  (RINDEX,  CINDEX  + 1) 

ATTEN 

87 

FRAC  = (F  - LOFREQ)  / (HIFREQ  - LOFREQ) 

ATTEN 

88 

ATTEN  = LOATTEN  + (FRAC  * (HIATTEN  - LOATTEN)  ) 

ATTEN 

89 

ATTEN  = ATTEN  * ( 1 + AFLAC  / 100  ) 

ATTEN 

90 

END  IF 

ATTEN 

91 

RETURN 

ATTEN 

92 

END 

ATTEN 

VARIABLE 

MAP-- 

(LO=A) 

NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

---SIZE 

AFLAC 

3 

DUMMY-ARG 

REAL 

ATTEN 

242B 

REAL 

C 

2S4B 

INTEGER 

CINDEX 

256B 

INTEGER 

EXACT 

2 6 0B 

LOGICAL 

F 

252B 

REAL 

FOUND 

257B 

LOGICAL 

FRAC 

243B 

REAL 

FREQ 

2 

DUMMY-ARG 

REAL 

HIATTEN 

2S1E 

REAL 

HIFREQ 

247B 

REAL 

ID 

1 

DUMMY-ARG 

CHAR* 3 

lERR 

2 6 2B 

INTEGER 

LOATTEN 

250B 

REAL 

LOFREQ 

246B 

REAL 

MAT 

OB 

/MATC/ 

CHAR*3 

100 

MATDESC 

36B 

/MATC/ 

CHAR*70 

1 00 

MATTEN 

OB 

/MATN/ 

REAL 

700 

MAXFREQ 

245B 

REAL 

MERR 

4374B 

/MATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

700 

MINFREQ 

24  4B 

REAL 

MRCOEF 

1 274B 

/MATN/ 

REAL 

700 

MTOT 

4375B 

/MATN/ 

INTEGER 

QA 

2570B 

/MATN/ 

REAL 

1 00 

QR 

2734B 

/MATN/ 

REAL 

100 

R 

253B 

INTEGER 

RINDEX 

255B 

INTEGER 

52 

53 

54 

55 

56 

57 

58 

59 

60 

61 

62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 
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FUNCTION  ATTEN  74/175  OPT=0 

-SYMBOLIC  CONSTANTS--(LO=A) 

-NAME TYPE VALUE 

MMAX  INTEGER  100 


-PROCEDURES--/ LO=A) 


NAME-- 

TYPE 

ARCS--- 

---CLASS 

ALOGIO 

REAL 

1 

INTRINSIC 

ERROR 

1 

SUBROUTINE 

STATEMENT  LABELS- 

-( LO=A) 

LABEL- 

ADDRESS 

-PROPERTIES- 

---DEF 

10 

INACTIVE 

DO-TERM 

44 

20 

INACTIVE 

DO-TERM 

70 

30 

INACTIVE 

DO-TERM 

81 

ENTRY 

POINTS--(LO 

= A) 

NAME-- 

-ADDRESS--ARGS 

ATTEN 

6B 

3 

-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

2&7B 

= 183 

CM  LABELLED  COMMON  LENGTH 

5730B 

= 30  32 

CM  STORAGE  USED 

61000B 

= 2S088 

COMPILE  TIME 

0.132 

SECONDS 
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9 

SUBROUTINE 

ERROR 

74/175  OPT 

= 0 

1 

SUBROUTINE  ERROR(IERR) 

ERROR 

2 

CHARACTER*45  MESSAGE(20) 

ERROR 

3 

DATA 

MESSAGE!  1)/ 

■MATERIALS 

DATA 

. BASE 

IS  EMPTY 

■ / 

ERROR 

4 

DATA 

MESSAGE!  1)1 

■ FREQUENCY 

IS  OUT  OF  ; 

RANGE 

■ / 

ERROR 

5 

DATA 

MESSAGE!  2)1 

■THIS  MATERIAL 

IS  NOT 

IN  DATA  BASE 

■ / 

ERROR 

6 

DATA 

MESSAGE!  4)/ 

'DENOMINATOR  IS 

ZERO 

■ / 

ERROR 

7 

DATA 

MESSAGE!  5)/ 

■FILE  HANDL 

ING 

ERROR 

■ / 

ERROR 

8 

DATA 

MESSAGE!  6)/ 

■ERROR 

CODE 

I S 

OUT 

OF 

RANGE 

■ / 

ERROR 

9 

DATA 

MESSAGE!  7)1 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

1 0 

DATA 

MESSAGE!  8)/ 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

' / 

ERROR 

11 

DATA 

MESSAGE!  9)1 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

12 

DATA 

MESSAGE!10) / 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

13 

DATA 

MESSAGE! 11)/ 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

1 4 

DATA 

MESSAGE! 12) / 

■ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

15 

DATA 

MESSAGE ! 13 ) / 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

1 6 

DATA 

MESSAGE!  1 4) / 

■ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

17 

DATA 

MESSAGE!15)/ 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

1 8 

DATA 

MESSAGE! 16)  / 

■ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

19 

DATA 

MESSAGE! 17)/ 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

20 

DATA 

MESSAGE!18)  / 

■ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

21 

DATA 

MESSAGE!  19  ) / 

■ ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

22 

DATA 

MESSAGE!2Q)  / 

‘ERROR 

CODE 

IS 

OUT 

OF 

RANGE 

■ / 

ERROR 

23 

IERRM=5 

ERROR 

24 

IF( lERR.GT. lERRM) 

IERR=20 

ERROR 

25 

WRITE(6,10)  lERR, MESSAGE! lERR) 

ERROR 

26  10 

FORMAT!'  ***ERROR 

NUMBER 

= ■ 

, 15  , 

' tut 

■ ,A45) 

ERROR 

27 

CALL 

PMDSTOP 

ERROR 

28 

STOP 

' ERROR ' 

ERROR 

29 

END 

ERROR 

-VARIABLE  MAP--!LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES 

TYPE 

SIZE 

lERR 

1 DUMMY-ARG 

INTEGER 

lERRM 

210B 

INTEGER 

MESSAGE 

56B 

CHAR*45 

20 

-PROCEDURES--(LO=A) 

-NAME TYPE ARCS CLASS 

PMDSTOP  0 SUBROUTINE 


-STATEMENT  LABELS-- ( LO=A) 

-LAB  EL- ADDRESS PROPERTIES DEF 

10  36B  FORMAT  26 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS 

ERROR  5B  1 


1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

1 1 

12 

13 

14 

15 

16 

1 7 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 
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10 


--I/O  UNITS--(LO=A) 
-NAME PROPERTIES 

TAPE6  FMT/SEQ 


--STATISTICS-- 

PROCRAM-UNIT  LENGTH  213B 
CM  STORAGE  USED  41000B 
COMPILE  TIME  0.055 


= 139 

= 25088 

SECONDS 
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1 1 


1 

2 

3 

4 

5 
i 

7 

8 
9 

10 

11 

12 

13 

14 

15 
U 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


SUBROUTINE  CFACTOR  CFACTOR 

* [ C C [ I [ C [ C [ [ [ I C C C I [ [ [ [ C [ [ C [ C [ [ [ I [ [ C t C [ [ [ [ C [ t [ C [ C C C [ [ C [ C [ C I [ C C C [ C C C C C I t I [CFACTOR 


C C [CFACTOR 
[ [ [CFACTOR 
[ [ [CFACTOR 
[ [ [CFACTOR 
[ [ [CFACTOR 
[[[CFACTOR 


*[  [ [ 

♦[[[  THIS  ROUTINE  CALCULATES  THE  ATTENUATION  OF  EACH  WALL  AND  EACH 
*[[[  OPENING  IN  EACH  WALL,  LAYER  BY  LAYER,  AND  THEN  CALCULATES  THE 
*[[[  COMPOSITE  TRANSMISSION  FACTORS  OF  EACH  WALL  USING  AN  APPROACH 
*[[[  DEVELOPED  BY  JERRY  WYSS . 

*[[[ 

*[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [ [CFACTOR 

************  *****  ****it*n**titt*  * mill*  ***  t*  **  at  n**  *************  ttttttCE  kCTOR 

***  VARIABLE  DEFINITIONS:  CFACTOR 

***  WATTEN:  WALL  ATTENUATION  CFACTOR 

***  OATTEN:  OPENING  ATTENUATION  CFACTOR 

***  LATTEN;  LAYER  ATTENUATION  CFACTOR 

***  MATTEN:  MATERIAL  ATTENUATION  CFACTOR 

***  MAT:  MATERIAL  IDENTIFICATION  CFACTOR 

***  ID:  IDENTIFICATION  OF  OPENING  CFACTOR 

***  WALL:  WALL  ARRAY  CONTAINING  WALL  IDENTIFICATION  AND  MATERIAL  CFACTOR 

***  WDIM:  WALL  ARRAY  CONTAINING  PHYSICAL  DIMENSIONS  OF  THE  WALL  CFACTOR 

***  WMAX:  MAXIMUM  SIZE  OF  WALL  AND  WDIM  ARRAYS  CFACTOR 

***  WTOT:  TOTAL  LINES  OF  DATA  IN  THE  THE  WALL  AND  WDIM  ARRAYS,  CFACTOR 

***  HEIGHT:  HEIGHT  OF  WALL  CFACTOR 

***  WIDTH:  WIDTH  OF  WALL  CFACTOR 

***  WDIM(R,C):  THICKNESS  OF  WALL  CFACTOR 

***  AREA:  AREA  CFACTOR 

***  WAREA:  TOTAL  WALL  AREA  WITHOUT  SUBTRACTING  OPENINGS.  CFACTOR 

***  OAREA:  TOTAL  AREA  OF  THE  OPENINGS.  CFACTOR 

***  NEWWALL.  TRUE  IF  DATA  LINE  BELONGS  TO  A NEW  WALL  CFACTOR 

***  WALLEND:  TRUE  IF  DATA  LINE  IS  THE  LAST  DATA  LINE  OF  A WALL  CFACTOR 

***  T:  TRANSMISSION  FACTOR  CFACTOR 

***  S:  AREA  OF  OPENING  OR  WALL  AS  APPROPRIATE  CFACTOR 

***  TS:  TRANSMISSION  FACTOR  = T1*S1  + T2S2  + T3*S3  + ...  CFACTOR 

***  TS2:  TRANSMISSION  FACTOR  = T1*S1*S1  + T2*S2*S2  + ...  CFACTOR 

***********************************************************************  * CFACTOR 
«*it«***it*«*«*it*****«x********it*****************«k**it*****«*****«****«**  *C0MF 
***  COMMON  FOR  INITIAL  PARAMETERS  ***COMF 

**«***«i******«********)t*****************«ix*««**********««***********«**itcOMF 
INTEGER  FMAX  COMF 

PARAMETER  (FMAX  = 50)  COMF 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR,  COMF 

$ FTOT  COMF 

COMMON  /INITILC/  BLDG  COMF 

CHARACTER  * 5 BLDG  COMF 

REAL  FREQ,  AFLAC,  RFLAG,  FREQA  COMF 

INTEGER  QUALITY,  FERR,  FTOT  COMF 

A**********************************************************************  *COMF 
************************************************************************ 
***********************************************************************  * COMH 
***  COMMON  FOR  DATABASE  OF  LOCATIONS  OF  DOORS  AND  WINDOWS  »**COMH 

*tt**«t*****t)«i«***lk*****«i****<r«lk******************lt*«i**«***it*****«)k******  *COMH 


INTEGER  HMAX 
PARAMETER  (HMAX  = 35) 

COMMON  /KOLEN/  HTOT,  HERR 
COMMON  /HOLEC/  HOLE (HMAX, 4) 
INTEGER  HTOT,  HERR 
CHARACTER  * 3 HOLE 


DESCRIPTION 

OF  ARRAYS 

ROOM  IDENTIFICATION 

APERTURE  ID 

DIRECTION 

FROM  ROOM 

TO  ROOM 

HOLE(X, 1) 

HOLE(X,2) 

HOLE(X, 3) 

HOLE(X,4) 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 
1 3 
14 
1 5 
16 

17 

18 

I 9 
20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 
13 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 

II 
12 

13 

14 

15 

16 
17 
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45  * A3  A3  A3  A3  COMH  18 

*tt*****ii**iiitiii(**»tiiiiii**ii***ttii*t*ii****ii***ii*ii*****ii**ii**tii*ttii******i(*  *COMH  1 9 

69  •»*  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  ***COMT  2 

71  INTEGER  TMAX  COMT  4 

72  PARAMETER  (TMAX=35)  COMT  5 

73  COMMON  /TYPEN/TDIM(TMAX,4) ,TTOT,TDB2(TMAX,2) ,TDBTOT,TERR  COMT  6 

74  COMMON  /TYPEC/TYPE(TMAX,  3)  .TDBKTMAX)  COMT  7 

75  INTEGER  TTOT , TDBTOT , TERR  COMT  8 

76  REAL  TDIM,TDB2  COMT  9 

77  CHARACTER  * 3 TYPE.TDBl  COMT  10 

78  *=================================================  COMT  11 

79  * DESCRIPTION  OF  ARRAYS  COMT  12 

80  »=================================================  COMT  13 

81  * ID  MATERIAL  FRAME  MATERIAL  COMT  14 

82  » COMT  15 

83  *TYPE(X,1)  TYPE(X,2)  TYPE(X,3)  COMT  16 

84  » A3  A3  A3  COMT  17 

85  * = ==  = = = ==  = = = = = = = = = = = = = = = =:  = = = = = = = = = = = = = = = = = = = = = = = = = COMT  18 

86  * HEIGHT  WIDTH  LAYER  DISTANCE  COMT  19 

87  * THICKNESS  ABOVE  FLOOR  COMT  20 

88  * COMT  21 

89  * TDIM(X,1)  TDIM(X,2)  TDIM(X,3)  TDIM(X,4)  COMT  22 

90  * F8.2  F8.2  F8.2  F8 . 2 COMT  23 

91  * = ==  = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = = =:  = = COMT  24 

92  * ID  ATTENUATION  AREA  COMT  25 

93  « COMT  26 

94  * TDBl(X)  TDB2(X,1)  TDB2(X,2)  COMT  27 

95  * A3  E9.3  E9.3  COMT  28 

99  ***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  ***COMR  2 

101  INTEGER  RMAX  COMR  4 

102  PARAMETER  (RMAX  = 20)  COMR  5 

103  COMMON  /ROOMN/  ROOM(RMAX  + 6,  RMAX  + 6),  NROOMS , RAREA(RMAX)  COMR  6 

104  INTEGER  NROOMS  COMR  7 

105  REAL  ROOM  COMR  8 

108  * * * * * t * * * It  * * * * * * t **  1 1 * * 1 1 * t * t * * * 1 1 * * * * * * * t * * 1 1 1 * t * * * * It  * 1 1 * * * * * * * * t * * * * t * 9 

109  ***  COMMON  FOR  DATABASE  OF  WALL  PARAMETERS  »**COMW  2 

111  INTEGER  WMAX  COMW  4 

112  PARAMETER  (WMAX  = 75)  COMW  5 

113  COMMON  /WALLN/  WD IM( WMAX , 3 ) , WTOT,  WERR  COMW  6 

114  COMMON  /WALLC/  WALL (WMAX, 4)  COMW  7 

115  INTEGER  WTOT, WERR  COMW  8 

116  REAL  WDIM  COMW  9 

117  CHARACTER  »3  WALL  COMW  10 

118  * =================================  COMW  11 

119  **  DESCRIPTION  OF  ARRAYS  COMW  12 

120  * =================================  COMW  13 

121  * WALL  IDENTIFICATION  COMW  14 

122  * COMW  15 

123  * DIRECTION  FROM  TO  COMW  16 

124  * ROOM  ROOM  COMW  17 

125  * COMW  18 

126  * WALL(X,1)  WALL(X,2)  WALL(X,3)  COMW  19 

127  * A3  A3  A3  COMW  20 

128  * =========================================================  COMW  21 
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13 


129 

130 

131 

132 

133 

134 

135 

136 

137 

138 

139 

140 

141 

142 

143 

144 

145 

146 

147 

148 

149 

150 

151 

152 

153 

154 

155 

156 

157 

158 

159 

160 
16  1 
162 

163 

164 

165 

166 

167 

168 

169 

170 
17  1 

172 

173 

174 

175 

176 

177 

178 

179 

180 
181 
182 

183 

184 

185 

186 

187 

188 

189 

190 
19  1 
192 


* WALL  PARAMETERS 

» 

* MATERIAL  HEIGHT  WIDTH 


LAYER  THICKNESS 


WDIM( I, 1) 
F8  . 2 


WDIMC  X, 2) 
F8  .2 


WDIMCX, 3) 
F8  . 2 


COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

»***COMW 

*»t*C0MW 


* WALL(X, 4) 

* A3 
*»***»»* 

ttt**tttt****tttiit* 


* COMMON  FOR  ABSORPTION  AND  REFLECTION  COEFFICIENTS  IN  WALLS  COMD 

COMMON  /ROOMD/DDABS (RMAX  + 6,  RMAX  + 6 ) ,DREFL,  DREFLV  COMD 

REAL  DDAES  ,DREFL  , DREFLW  COMD 


i**«*****«***************  * COMD 


RMAX  + 5 


x***it*it«***«*«*«*ik*t******«****«**it*********«**«** 

* DECLARATION  OF  VARIABLES 

****«X***X*********»**t**t**«*«*«t(*«X«t***«***«*t 

INTEGER  NEXT,  LAST,  R,  C,  ROW 

REAL  WATTEN , LATTEN , OATTEN , MATTEN, ATTEN ,T , 5 , TS , TS2 
REAL  HEIGHT,WIDTH,AREA,OAREA,WAREA 
CHARACTER  * 3 FROM,  TO,  MAT,  ID 
LOGICAL  NEWVALL ,WALLEND 

* INITIALIZE  ROOM  MATRIX. 

*«x««**««*****t**«x***********«**«*****«****t****t 

DO  5 R = 1,RMAX 
DO  5 C = 1 ,RMAX 
ROOM(R,C)  = 0.0 

5 CONTINUE 

DO  6 R = 1,RMAX 

DO  6 C = RMAX  + 1, 

ROOM(R,C)  = 0.0 

6 CONTINUE 

* LOOP  S PROCESS  EACH  LAYER  OF  THE  WALL  ARRAY 

*******t**«***«**«t*«****t**«**«««***««t*««*«***** 

DO  10  R = 1 ,WTOT 

t***t******t***tttt**iiiittt*ttt*t*****tiitt****t*t*t 

* SET  WALLEND  CONDITION 

**tt*tt**ttt*t*t*t*ttt*t***t***t**t**t**t*t*ttiiim* 

NEXT  = R + 1 
IF  (R  .EQ.  WTOT)  THEN 
WALLEND  = TRUE 
ELSE  IF  ( WALL(R,2)  ,NE 
$ WALL(R,3)  ,NE. 

WALLEND  = TRUE. 

ELSE 

WALLEND  = FALSE. 

END  IF 

**t***<«««************«*«*t(t«******«t*t*«*X*(*«t« 

* SET  NEWWALL  CONDITION 

»*»»**»»»***»*t»»»»»»»**»»»»»»***»*»***t»»*»»»t»»* 

LAST  = R - 1 
IF  (R  EQ.  1)  THEN 
NEWWALL  = TRUE. 

ELSE  IF  ( WALL(R,2)  NE 
$ WALL(R,3)  .NE. 

NEWWALL  = TRUE. 

ELSE 

NEWWALL  = FALSE. 

END  IF 

xtxxtxxxtttxxxxxttxtxxxxt************************* 


WALL(NEXT, 
WALL (NEXT , 


.OR  . 

) THEN 


WALL(LAST,2) 

WALL(LAST,3) 


OR. 

) THEN 


CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 

CFACTOR 


22 

23 

24 

25 

26 

27 

28 
29 

1 

2 

3 

4 

5 

6 
7 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 

65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 
7 ? 
80 
81 
82 

83 

84 

85 

86 

87 

88 
89 
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173 

1*4 

175 

1 »6 
17-> 
17! 
17  9 
200 
20  1 
202 
20  3 

204 

205 

206 
207 
20! 
209 

2 10 
211 
212 
213 
2 1 4 

215 

216 
217 
2 18 

219 

220 
22  1 
222 

22  3 

224 

225 

226 

227 

228 

229 

230 

23  1 

232 

233 

234 

235 

236 

237 

238 

239 

240 

241 

242 

243 

244 

245 

246 

247 

248 

249 

250 

251 

252 

253 

254 

255 

256 


• CALCULATE  WALL  ATTENUATION,  LAYER  BY  LAYER 

IF  (NEUVALL)  THEN 

• INITIALIZE  VALL  CONDITIONS 

•xtiiiixtxtiiitxxxxiixxxxixxxxxxxxxxxxxxxxxxxxxxxx 

TS  = 0 
TS2  = 0 
WATTEN  = 0 
END  IF 

•lltXttItttXXIIItXXtIIXXXXXXXXXXXXXXXXXXXXIXXIXXXX 

• CALCULATE  ATTENUATION  OF  LAYER 

tiiiixifxixxixxxxxxxxxxxxxixxxxxxxxxxxxitxxxxxxxxx 

MAT  = VALL(R,4) 

MATTEN  = ATTEN  (MAT. FREQ, AFLAC) 

LATTEN  = MATTEN  » VOIM(R,3) 

tixixxixxxxtxixxxxxxxixxxxxxxxxxxxxxxxxxxxxtxxxxxx 

• ACCUMULATE  ATTENUATION  OF  VALL  FROM  LAYERS 

xxxxxxxixxxixxxxxxxxxxxxxxixxxxxxixxxxxxxxxxxxxxxx 

WATTEN  = VATTEN  + LATTEN 

XtXIIIXXXXtXXXIIXXtXXXXXXXXXXXXXXXXXIXXXXXXXXXXXXX 

ixxtxxxxxxxxxxxxixxxxxxxxxxxxxxxxxtxxxxxxxttxxxxxx 

• CHECK  IF  END-OF-VALL  LAYER 

» AND  THEN  CALCULATE  VALUES  FOR  HOLES  IF  TRUE . 

• . OTHERWISE  GO  BACK  AND  DO  THE  NEXT  LAYER- 

txxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

IF  (VALLEND)  THEN 
FROM  = VALL(R,2) 

TO  = VALL(R,3) 

XXXXXXXXXXXXXXXXXXXXXXXXXXXXXIXXXXXXXXXXXXXXXXXXXX 

• ..CALCULATE  ATTENUATION  OF  OPENINGS 

• AND  TOTAL  AREA  OF  OPENINGS 

xxxxxxxxxxxxxxxxxxixxxxxxxxxxxxxxxxxxxxxtxxxxtttxx 

OAREA  = 0 

DC  20  ROW  = 1,  HTOT 

xxixxxxxxtxxxxxxxxxxxxxxxxxxxxxxxxxxtxxxxxxixtxixx 

» ...CHECK  FOR  A HOLE  IN  PRESENT  VALL 

xxxxxxxxxxxxxxxxxxxxxtxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

IF  (HOLE(ROW,2)  .EG.  FROM  .AND.  HOLE(RCV,3) 

XXXXXXXXXXXtXXIXXXXXXXXXXXXXXXXXXXXXXXXXXXXIXXXXXX 

• ...IF  THERE  IS  A MATCH.  CALCULATE  ITS  CONTRISUTIOK; 

• ..OTHERWISE  KEEP  SEARCHING  HOLE'S  TABLE 

tixxxxxxxxxxxxxxxxxxxxxxtixxxxxxxxxxxxxxxxxxxxxxxx 

ID  = HGLE(ROV,4) 

xxxxxxxxxxtxxtxxxxxxxxxxxtxxtxxxxxxxtxxxxxxxxxxxxx 

• ...GET  ATTENUATION  AND  AREA  OF  HOLE 

XXXXXXXXXXXXXXXXXXXXXXXIXXXXXXXXXXXXXXXXXXXXXXXXXX 

CALL  SRCHTD2CID,  OATTEN.AREA) 

OAREA  = OAREA  + AREA 
CALL  RESOND  (ID) 

IF  (OATTEN  .LE.  120)  THEN 

XXXXXXXXXXXXXXXXxXXXXXXXXXXXXXtXXXXXXXXXXXXXXXXXXX 

• ...CALCULATE  TRANSMISSION  OF  HOLE. 

• .. .SET  TO  ZERO  IF  LESS  THAN  120  DB 

T = 1 0**( (-OATTEN  + DREFLV)  / 10  ) 

ELSE 
T = 0 
END  IF 
S = AREA 

XXXXXXXXXXXXXXXXXiXtXXXXXXXXXXXXXXIXXXXXXXIXXXXXXX 

» ...ACCUMULATE  TRANSMISSION  * AREA  AND 

• ...TRANSMISSION  * AREA  * AREA 

» . . .FOR  HOLES  IN  VALL. 


.EG.  TO)  THEN 


: FACTOR 

CFACTOR 

« 2 

CFACTOR 

93 

CFACTCR 

94 

CFACTOR 

95 

CFACTOR 

7 £ 

CFAOTOR 

97 

CFACTOR 

98 

Cr AC7CH 

CFACTOR 

ISC 

CFAOTOR 

131 

OFAOTCR 

1C2 

CFAOTOR 

13  2 

CFACTOR 

A.  • M 

CFACTCR 

1 35 

CFAOTOR 

1 C 6 

CFACTOR 

137 

CFACTOR 

• f*.  S 

CFACTCR 

13? 

CFACTOR 

lie 

CFACTCR 

111 

CFACTCR 

113 

CFACTCR 

113 

CFACTOR 

1 1 4 

CFAOTOR 

« * 5 

CFACTCR 

1 1 £ 

CFACTCR. 

1 17 

CFACTCR 

115 

CFACTCR 

1 19 

CFACTCR 

ICC 

CFACTCR 

121 

OFAOTCR 

122 

CFACTOR 

1 23 

CFACTCR 

12  4 

CFACTOR 

1 25 

CFACTOR 

12  6 

CFACTCR 

127 

CFACTOR 

12! 

CFACTCR 

1 2 T 

CFACTCR 

1 3 3 

CFACTCR 

131 

CFACTCR 

132 

CFACTOR 

133 

CFACTCR 

134 

CFACTCR 

1 35 

CFACTOR 

136 

CFACTOR 

137 

CFACTCR 

1 3 8 

CFACTCR 

1 39 

CFACTOR 

14C 

CFACTOR 

141 

CFACTOR 

142 

CFACTCR 

1 42 

CFACTCR 

1 4 4 

CFACTCR 

1 45 

CFACTOR 

146 

CFACTCR 

1 4' 

CFACTOR 

1 4 8 

CFACTOR 

1 47 

CFACTOR 

15C 

CFACTOR 

151 

CFACTCR 

152 

CFACTCR 

153 

221 


FTN  5.1+552  84/03/14.  10.18.23  PAGE 

SUBROUTINE  CFACTOR  74/175  OPT=0 


15 


257 

258 

259 

260 
26  1 
242 
24  3 

244 

245 
244 

247 

248 

249 
270 

27  1 

272 

273 

274 

275 
274 

277 

278 

279 

280 

28  1 
282 

283 

284 

285 
284 

287 

288 

289 

290 

291 

292 

293 

294 


t************************************************* 
TS  = TS  + T * S 
TS2=TS2+T*S*S 
END  IF 

20  CONTINUE 

«t***ft**«***t***«tk*********************«**it««**A*|t* 

* CALCULATE  & STORE  ATTENUATION  OF  EACH  ROOM 
. . CALCULATE  TOTAL  WALL  AREA 


HEIGHT  = UDIM(R, 1) 

WIDTH  = WDIM(R,2) 

WAREA  = HEIGHT  * WIDTH 
S = WAREA  - OAREA 

****«**(i********tklt*ik1k*1k**lt**««[****«**Alk**)t******tlr* 

* ...CALCULATE  ATTENUATION 

**mi1l**t1i****ii*ii***it1t*ii»/HI)ilr*li1itHHHHt*****»*t1i*»»*» 
IF  (WATTEN  .LE.  120.)  THEN 


* ...CALCULATE  TRANSMISSION  OF  WALL. 

* ...SET  TO  ZERO  IF  LESS  THAN  -120  DB  . 

********k***lk4t<(**tt****1tlt4l*****lt**ik**lt*lk«lkkit**AttAlt* 

T = 10** (-WATTEN  / 10) 

ELSE 
T = 0 
END  IF 

TS  = TS  + T * S 
TS2  = TS2  + T * S * S 

*lM)**«ik******k*****lt*ik*it*t)*****A**4itit****)t*ili*****lt 


* ...INSERT  TOTAL  TRANSMISSION  * AREA  OF  WALL  INTO  ROOM  ARRAY 

kkk********k***********«k***kk***k**«*k*k********* 


CALL  LROOM  ( TS , TS2 , FROM , TO ) 
END  IF 
10  CONTINUE 
RETURN 
END 


CFACTOR 

154 

CFACTOR 

1 55 

CFACTOR 

154 

CFACTOR 

1 57 

CFACTOR 

158 

CFACTOR 

1 59 

CFACTOR 

140 

CFACTOR 

141 

CFACTOR 

142 

CFACTOR 

1 43 

CFACTOR 

144 

CFACTOR 

1 45 

CFACTOR 

144 

CFACTOR 

147 

CFACTOR 

148 

CFACTOR 

1 49 

CFACTOR 

170 

CFACTOR 

171 

CFACTOR 

172 

CFACTOR 

173 

CFACTOR 

174 

CFACTOR 

1 75 

CFACTOR 

174 

CFACTOR 

1 77 

CFACTOR 

17  8' 

CFACTOR 

1 79 

CFACTOR 

180 

CFACTOR 

1 81 

CFACTOR 

182 

CFACTOR 

1 83 

CFACTOR 

184 

CFACTOR 

185 

CFACTOR 

184 

CFACTOR 

187 

CFACTOR 

188 

CFACTOR 

1 89 

CFACTOR 

190 

CFACTOR 

191 

-VARIABLE 

MAP-- 

(LO=A) 

-NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

---SIZE 

AFLAC 

2B 

/ INITILN/ 

REAL 

AREA 

500B 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

C 

444B 

INTEGER 

DDABS 

OB 

/ROOMD/ 

REAL 

474 

DREFL 

1 244B 

/ROOMD/ 

REAL 

DREFLW 

1 245B 

/ROOMD/ 

REAL 

FERR 

44B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FROM 

50  3B 

CHAR*3 

FTOT 

47B 

/ INITILN/ 

INTEGER 

HEIGHT 

474B 

REAL 

HERR 

IB 

/HOLEN/ 

INTEGER 

HOLE 

OB 

/HOLEC / 

CHAR*3 

1 40 

HTOT 

OB 

/HOLEN/ 

INTEGER 

ID 

504B 

CHAR*3 

LAST 

442B 

INTEGER 

LATTEN 

44  7B 

REAL 

MAT 

505B 

CHAR*3 

MATTEN 

471B 

REAL 

222 


FTN  5 1+552 

84/03/14.  10.18.23  PAGE 

16 

SUBROUTINE 

CFACTOR  74/175  OPT=0 

NEVUALL 

5 0 7B 

LOGICAL 

NEXT 

46  IB 

INTEGER 

NROOMS 

1 244B 

/ROOMN/ 

INTEGER 

OAREA 

50  IB 

REAL 

OATTEN 

470B 

REAL 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

46  3B 

INTEGER 

RAREA 

1 2 45B 

/ROOMN/ 

REAL 

RFLAC 

3B 

/ INITILN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

ROW 

465B 

INTEGER 

S 

473B 

REAL 

T 

472B 

REAL 

TDBTOT 

323B 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

TDB2 

215B 

/TYPEN/ 

REAL 

TDIM 

OB 

/TYPEN/ 

REAL 

TERR 

32  4B 

/TYPEN/ 

INTEGER 

TO 

504B 

CHAR*3 

TS 

474B 

REAL 

TS2 

475B 

REAL 

TTOT 

214B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

WALL 

OB 

/WALLC/ 

CHAR*3 

WALL END 

510B 

LOGICAL 

UAREA 

50  2B 

REAL 

WATTEN 

466B 

REAL 

WDIM 

OB 

/WALLN/ 

REAL 

WERR 

342B 

/WALLN/ 

INTEGER 

WIDTH 

477B 

REAL 

WTOT 

341B 

/WALLN/ 

INTEGER 

-SYMBOLIC 
-NAME 

CONSTANTS--(LO=A) 

TYPE 

VALUE 

FMAI 

INTEGER 

50 

HMAX 

INTEGER 

35 

RMAX 

INTEGER 

20 

TMAX 

INTEGER 

35 

WMAX 

INTEGER 

75 

-PROCEDURES--(LO=A) 
-NAME TYPE 

--ARGS 

CLASS 

ATTEN  REAL 

3 

FUNCTION 

LROOM 

4 

SUBROUTINE 

RESOND 

1 

SUBROUTINE 

SRCHTDB 

3 

SUBROUTINE 

20 

676 


35 

70 

140 


105 

300 


225 


-STATEMENT  LABELS- -( LO= A > 

-LAB  EL- ADDRESS PROPERTIES DEF 


5 

INACTIVE 

DO-TERM 

158 

6 

INACTIVE 

DO-TERM 

1 62 

10 

INACTIVE 

DO-TERM 

292 

20 

INACTIVE 

DO-TERM 

261 
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-ENTRY  POINTS--(LO=A) 

-NAME ---ADDRESS- -ARCS-- - 

CFACTOR  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


521B  = 337 

4000B  = 2048 

63000B  = 26112 

0.249  SECONDS 
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10 
11 
12 
13 
1 4 
IS 
U 

17 

18 

19 

20 
21 
22 

23 

24 

25 
28 

27 

28 

29 

30 

31 

32 

33 

34 

35 
38 
37 


1 SUBROUTINE  LHOLE  LHOLE 

2 *[[[[[[[[[ tCC[C[[[C[[[[C[[[CCCCCC[CCC[CCC[[t[C[C[[[CCCCC[C[CCCC[[C[CCC[[LHOLE 

3 »[[[  [[[LHOLE 

4 »[[[  LOAD  THE  CONTENTS  OF  THE  "HOLE"  FILE  INTO  THE  "HOLE"  ARRAY  [[[LHOLE 

5 *[[[  [[[LHOLE 

8 *[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[[[LHOLE 

7 ****t*iiii****tiiiit*ii*tt*****t****iiii»lili*ttli**tt**tttiitlili*lit**ii***t***t**t*  * COKH 

8 »»*  COMMON  FOR  DATABASE  OF  LOCATIONS  OF  DOORS  AND  WINDOWS  **»COMH 

9 * ( * « * I 

INTEGER  HMAX 
PARAMETER  (HMAX  = 35) 

COMMON  /HOLEN/  HTOT,  HERR 
COMMON  /HOLEC/  HOLE(HMAX,4) 

INTEGER  HTOT,  HERR 


CHARACTER  * 3 HOLE 


COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 

COMH 


t t t tit  t 1 1 t t * Hit  t 1 1 t * H * t t t * 1 1 * t 1 1 t * t t t t * t 1 1 t t t t * t t t It  1 1 t * * * t * * t t t t t t It  t * t 1 1 t 

**  COMMON  FOR  INITIAL  PARAMETERS  ***COMF 


DESCRIPTION 

OF  ARRAYS 

ROOM  IDENTIFICATION 

APERTURE 

ID 

DIRECTION 

FROM  ROOM 

TO  ROOM 

HOLE( X, 1 ) 
A3 

HOLE( X, 2) 
A3 

HOLE(X, 3) 
A3 

HOLE(X 

A3 

, 4) 

INTEGER  FMAX  COMF 

PARAMETER  (FMAX  = 50)  COMF 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR,  COMF 

$ FTOT  COMF 

COMMON  /INITILC/  BLDG  COMF 

CHARACTER  * 5 BLDG  COMF 

REAL  FREQ,  AFLAC,  RFLAG,  FREQA  COMF 

INTEGER  QUALITY,  FERR,  FTOT  COMF 

3g  *******Alklt**A****ltfl**********ti**))1kltk*tttlk**********AilMk****i4t4l*4l*A*<itt*****lkQO]^p 

40  INTEGER  GETLEN,  R,  C LHOLE 

41  CHARACTER  * 7 PFN  LHOLE 

42  PFN  = ‘B’  II  BLDG( 1 ;GETLEN(BLDG) ) II  'H'  LHOLE 

43  HERR  = 0 LHOLE 

44  CALL  PF  ( 'GET' ,0 ,PFN(1 :GETLEN(PFN) ), ‘RC , HERR)  LHOLE 

45  IF  ( HERR  . EQ . 0 ) THEN  LHOLE 

48  OPEN  (UNIT=3,  FILE=PFN,  FORM= ' FORMATTED ' , LHOLE 

47  $ STATUS= 'OLD' , ACCESS= ’ SEQUENTIAL ' ) LHOLE 

48  1000  FORMAT  ( 1 X , 4 ( 1 X , A3 ) ) LHOLE 

49  HTOT  = 0 LHOLE 

50  DO  10  R = 1,HMAX  LHOLE 

51  READ  (3  , 1000  , END  = 20) (HOLE(R, C) ,C=1 , 4)  LHOLE 

52  HTOT  = HTOT  + 1 LHOLE 

53  10  CONTINUE  LHOLE 

54  20  CONTINUE  LHOLE 

55  CLOSE(3,STATUS='DELETE' ) LHOLE 

58  ELSE  IF  ( HERR  .EQ.  2 ) THEN  LHOLE 

57  CALL  WARNING  (1)  LHOLE 

58  ELSE  LHOLE 

59  CALL  WARNING  (2)  LHOLE 

80  END  IF  LHOLE 

81  RETURN  LHOLE 

82  END  LHOLE 


1 

2 

3 

4 

5 
8 
1 
2 

3 

4 

5 
8 

7 

8 
9 

10 
1 1 
12 

13 

14 

15 
18 

17 

18 

19 

20 
1 
2 

3 

4 

5 
8 

7 

8 
9 

10 
1 1 
12 

I 3 
9 

10 

II 
12 

13 

14 

15 
1 8 
17 
1 8 

19 

20 
21 
22 

23 

24 

25 
28 

27 

28 

29 

30 

31 
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-VARIABLE 

MAP-- 

( LO=A) 

-NAME---ADDRESS 

-BLOCK PROPERTIES 

TYPE 

---SIZE 

AFLAG 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

C 

214B 

INTEGER 

TERR 

66B 

/INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTOT 

67B 

/ INITILN/ 

INTEGER 

HERR 

IB 

/HOLEN/ 

INTEGER 

HOLE 

OB 

/HOLEC/ 

CHAR* 3 

1 40 

HTOT 

OB 

/HOLEN/ 

INTEGER 

PFN 

215B 

CHAR*7 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

213B 

INTEGER 

RFLAG 

3B 

/ INITILN/ 

REAL 

-SYMBOLIC  CONSTANTS-- (LO=A) 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

HMAX  INTEGER  35 


-PROCEDURES--(LO=A) 
-NAME TYPE 

GETLEN  INTEGER 

PF 

WARNING 


ARGS CLASS 

1 FUNCTION 

5 SUBROUTINE 

1 SUBROUTINE 


-STATEMENT  LABELS- -( LO=A ) 


-LABEL- 

ADDRESS 

--PROPERTIES 

-DEF 

10 

INACTIVE 

DO-TERM 

53 

20 

73B 

54 

1000 

130B 

FORMAT 

48 

-ENTRY  POINTS--(LO=A> 
-NAME ADDRESS- -ARGS 

LHOLE  5B  0 


-I/O  UNITS--(LO=A) 
-NAME PROPERTIES- 

TAFE3  AUX/FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


222B  = 146 

MSB  = 101 

61000B  = 25088 

0.094  SECONDS 
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1 

2 

3 

4 

5 
i 

7 

8 
9 

10 
11 
1 2 

13 

14 

15 
1 6 
17 
1 8 

19 

20 
21 
22 

23 

24 

25 
28 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


SUBROUTINE  LMATTER  LMATTER 
• t C C [[[ C C t C [ C [[ C [[[[[[[ C C [[[ t C [[ C L [ C [ C C C [ C C C C L C C C [ C C C C [[[ C C C C C C C C [[ C C [ C [ LMATTER 
*[[[  [[[LMATTER 
*[[[  THIS  SUBROUTINE  LOADS  THE  MATERIAL  DATABASE  INTO  ARRAYS  FOR  [[[LMATTER 
•([[  FURTHER  PROGRAM  USE.  [[[LMATTER 
»[[(  [[[LMATTER 
»[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ LMATTER 


************1 


»*•  COMMON  FOR  DATABASE  OF  MATERIAL  PROPERTIES 


***COMM 


INTEGER  MMAX  COMM 

PARAMETER  (MMAX=100)  COMM 

COMMON  /MATN/  MATTEN ( MMAX , 7 ) , MRCOEF (MMAX , 7 ) , QA(MMAX),  QR(MMAX),  COMM 
5 MFREQIMMAX, 7) , MERR,  MTOT  COMM 

COMMON  /MATC/MAT(MMAX) ,MATDESC(MMAX)  COMM 

INTEGER  MTOT,  MERR  COMM 

REAL  MATTEN,  MRCOEF,  MFREQ,  QA , OR  COMM 

CHARACTER  * 3 MAT  COMM 

CHARACTER  * 70  MATDESC  COMM 


* DECLARATION  OF  VARIABLES 

tAAt********************************************** 

INTEGER  R,  C,  VAL 
CHARACTER  * 3 MATID 

tiiiitii*ii*tt*iiniitt*t****iit**t*t*ttttt*t**t******t*tt 

* GET  FILE 

It************************************************* 

MERR  = 0 

CALL  PF  ( 'GET' ,0, 'MATTER' , 'RC  , MERR) 

************************************************** 

* FILE  ERROR  CHECK 

************************************************** 

IF  ( MERR  .EQ.  0 ) THEN 
999  CONTINUE 

ELSE  IF  ( MERR  .EQ.  2 ) THEN 
CALL  WARNING  (3) 

RETURN 

ELSE 

CALL  WARNING  (4) 

RETURN 
END  IF 

************************************************** 

» OPEN  FILE 

************************************************** 

OPEN  (UNIT  = 3,  FILE='MATTER' ,FORM='FORMATTED' , 
5 STATUS  = 'OLD',  ACCESS  = 'SEQUENTIAL') 

REWIND  (3) 

************************************************** 

* INITIALIZE  ARRAYS 

************************************************** 

DATA  MAT  / 100  » ' ' / 

DATA  MATDESC  / 100  * ' ' / 

DATA  MFREQ  / 700  * 0.0  / 

DATA  MATTEN  / 700  * 0.0  / 

DATA  QA  / 100  * 0 .0  / 

DATA  MRCOEF  / 700  * 0.0  / 

DATA  QR  / 100  * 0.0  / 

************************************************** 

* READ  IN  THE  MATERIAL  FILE 
************************************************** 

10  READ  (3,1000,END=20)  MATID 


LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 

LMATTER 


1 

2 

3 

4 

5 

6 

7 

8 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 

I 3 

14 
10 

II 
12 
13 
1 4 

15 
1 6 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 
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65 

R = VAL(MATID( 2 ; 3 ) ) 

LMATTER 

52 

66 

MAT  (R)  = MATID 

LMATTER 

53 

67 

READ  (3 , 2000 , END=20) 

MATDESC  (R) 

LMATTER 

54 

68 

READ  ( 3 , 4000 , END=20 ) 

(MFREQ(R,C) ,C=1 ,7) 

LMATTER 

55 

69 

READ  (3 , 4000 , END=20) 

(MATTEN(R,C) ,C=1 , 7) 

LMATTER 

56 

70 

READ  (3,4000,END=20) 

QA  (R) 

LMATTER 

57 

71 

READ  (3 , 4000 , END=20) 

(MRCOEF(R,C) ,C=1 , 7) 

LMATTER 

58 

72 

READ  (3,4000,END=20) 

QR  (R) 

LMATTER 

59 

73 

GOTO  10 

LMATTER 

60 

74 

20 

CONTINUE 

LMATTER 

61 

75 

1000 

FORMAT  (A3) 

LMATTER 

62 

76 

2000 

FORMAT  (A70) 

LMATTER 

63 

77 

40  00 

FORMAT  (7(1X,E9.3)) 

LMATTER 

64 

78 

A************************************************* 

LMATTER 

65 

79 

* CLOSE  FILE 

LMATTER 

66 

80 

****«**«**«**«ft**ft***ft****ft**«*«*«ft*«**«*«**«*«*«* 

LMATTER 

67 

81 

CLOSE  (3, STATUS  = 'DELETE' > 

LMATTER 

68 

82 

RETURN 

LMATTER 

69 

83 

END 

LMATTER 

70 

-VARIABLE  MAP 

--(LO=A) 

-NAME- --ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


C 

327B 

INTEGER 

MAT 

OB 

/MATC/ 

CHAR*3 

100 

MATDESC 

36B 

/MATC/ 

CHAR*70 

1 00 

MATID 

330B 

CHAR*3 

MATTEN 

OB 

/MATN/ 

REAL 

700 

MERR 

4374B 

/MATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

700 

MRCOEF 

1 274B 

/MATN/ 

REAL 

700 

MTOT 

4375B 

/MATN/ 

INTEGER 

QA 

2570B 

/MATN/ 

REAL 

100 

QR 

2734B 

/MATN/ 

REAL 

1 00 

R 

326B 

INTEGER 

-SYMBOLIC  CONSTANTS- 
-NAME TYPE 

-(LO=A> 

VALUE 

MMAX  INTEGER 

1 00 

-PROCEDURES--(LO=A) 
-NAME TYPE 

ARGS-  - 

---CLASS 

PF 

5 

SUBROUTINE 

VAL  INTEGER 

1 

FUNCTION 

WARNING 

1 

SUBROUTINE 

-STATEMENT  LABELS-- ( LO=A ) 


LABEL 

-ADDRESS 

--PROPERTIES  DEF 

-LABEL-ADDRESS--- 

---PROPERTIES-- 

--DEF 

10 

36B 

64 

1000  202B 

FORMAT 

75 

20 

160B 

74 

2000  204B 

FORMAT 

76 

999 

*NO  REFS* 

37 

4000  206B 

FORMAT 

77 
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-ENTRY  POINTS--! LO=A) 

-NAME ADDRESS --ARCS 

LMATTER  5B  0 


-1  IQ  UNITS--(LO=A) 
-NAME---  PROPERTIES- 

TAPE3  AUX/FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

336B 

= 222 

CM  LABELLED  COMMON  LENGTH 

5 73  0B 

= 30  32 

CM  STORAGE  USED 

61000B 

= 25088 

COMPILE  TIME 

0 .1  38 

SECONDS 
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1 

2 

3 

4 

5 
i 

7 

8 
9 

10 
11 
1 2 
13 
1 4 
15 
U 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


SUBROUTINE  LRAREA  LRAREA 

*C  m:C[  t [[[[[[[[[[[[[[[  [[[CC[C[[[CCCCC[[CC[t[[[[[tCCCCCCC etc  It tltCCCICI [LRAREA 


*[  [ t 
*C  [[ 
*[  C C 
*C  C [ 


CALCULATE  THE  SURFACE  AREA  OF  EACH  ROOM 
AND  INSERT  IT  IN  THE  "RAREA"  ARRAY 


[ [ [LRAREA 
[ [[LRAREA 
[ [ [LRAREA 
[ [ [ LRAREA 


*[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[[[[[[[[[[[[[[[[[LRARE A 


***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  *»*COMR 

*******************tk**********«**l[i*Kllr*«***«ik********it***«**«***«*****«r**COMR 


INTEGER  RMAX  COMR 
PARAMETER  (RMAX  = 20)  COMR 
COMMON  /ROOMNZ  ROOM(RMAX  + 6,  RMAX  + 6),  NROOMS , RAREA(RMAX)  COMR 
INTEGER  NROOMS  COMR 
REAL  ROOM  COMR 


***************it***************»****iktt**«i***********«t«***«*********«****C0MR 
**********************************************************************  * * COMR 


***  COMMON  FOR  DATABASE  OF  WALL  PARAMETERS  ***COMV 

**lk*****1i*******A******ft**A*****1k***A1t*A*fttft*llr***lt**ltA*ft'K***1ttt**«*A1t***  COMV 


INTEGER  WMAX 
PARAMETER  (WMAX  = 75) 

COMMON  /WALLN/  WD IM ( WMAX , 3 ) , WTOT,  WERR 
COMMON  /WALLC/  WALL (WMAX, 4) 

INTEGER  WTOT, WERR 
REAL  WDIM 
CHARACTER  *3  WALL 


**  DESCRIPTION  OF  ARRAYS 
* ====================== 


* WALL  IDENTIFICATION 


DIRECTION 

FROM 

ROOM 

TO 

ROOM 

WALL (X  , 1 ) 
A3 

WALL(X  ,2) 
A3 

WALL(X,3) 

A3 

WALL  PARAMETERS 

MATERIAL 

HEIGHT 

WIDTH 

LAYER  THICKNESS 

WALL( X, 4) 

WDIM( X,  1 ) 

WDIM( X, 2) 

WDIM( X, 3) 

A3 

F8  . 2 

F8  . 2 

F8  . 2 

COMW 

COMV 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

»*COMW 


* DECLARATION  OF  VARIABLES 


INTEGER  NEXT,  LAST,  R,  RNUM,  VAL 
CHARACTER  * 3 FROM,  TO 
LOGICAL  NEWWALL,  WALLEND 

************************************************** 


LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 

LRAREA 


1 

2 

3 

4 

5 

6 
7 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 
29 
10 
11 
12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 
27 
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85 

LRAREA 

28 

66 

* SET  WALLEND  CONDITION 

LRAREA 

29 

67 

t**«*t*«««*«iti>***ti*ik*A«********DtMt)tti*)k***tlr))***ft*** 

LRAREA 

30 

68 

NEXT  = R + 1 

LRAREA 

31 

6? 

IF  (R  EQ.  WTOT)  THEN 

LRAREA 

32 

70 

WALLEND  = TRUE. 

LRAREA 

33 

71 

ELSE  IF  ( WALL(R,2)  NE.  WALL(NEXT,2)  OR. 

LRAREA 

34 

72 

5 UALL(R,3)  .NE.  WALL(NEXT,3)  ) THEN 

LRAREA 

35 

73 

WALLEND  = .TRUE. 

LRAREA 

36 

74 

ELSE 

LRAREA 

37 

75 

WALLEND  = .FALSE. 

LRAREA 

38 

76 

END  IF 

LRAREA 

39 

77 

t»*ii****t*ii****tiit**ii***tttit******t*ti(ii*tt*ii*iit*ii* 

LRAREA 

40 

78 

* SET  NEWWALL  CONDITION 

LRAREA 

41 

79 

LRAREA 

42 

80 

LAST  = R - 1 

LRAREA 

43 

81 

IF  (R  .EQ.  1)  THEN 

LRAREA 

44 

82 

NEWWALL  = .TRUE. 

LRAREA 

45 

83 

ELSE  IF  ( WALL(R,2)  .NE.  WALL(LAST,2)  .OR. 

LRAREA 

46 

84 

$ WALL(R,3)  .NE.  WALL(LAST,3)  ) THEN 

LRAREA 

47 

85 

NEWWALL  = TRUE. 

LRAREA 

48 

86 

ELSE 

LRAREA 

49 

87 

NEWWALL  = .FALSE. 

LRAREA 

50 

88 

END  IF 

LRAREA 

51 

89 

**1tAA1t*«A*ft*t**t**AllrAAt***AAft**AA*ttft1icft***1lr*AA«*t* 

LRAREA 

52 

90 

* INSERT  THE  AREA  INTO  THE  ARRAY 

LRAREA 

53 

91 

t*****tt1tlt1kt**ftA*AA*AAt**A*tA**1it*AA*ft****t*1ltft1ttAt** 

LRAREA 

54 

92 

IF  (NEWWALL)  THEN 

LRAREA 

55 

93 

FROM  = WALL  (R , 2) 

LRAREA 

56 

94 

TO  = WALL  (R,3) 

LRAREA 

57 

95 

IF  ( FROMd:  1)  .EQ.  'D'  ) THEN 

LRAREA 

58 

96 

RNUM  = VAL  ( TO(l : 2)  ) 

LRAREA 

59 

97 

RAREA(RNUM)  = RAREA  (RNUM)  + WD IM ( R , 1 ) *WD IM ( H , 2 ) 

LRAREA 

60 

98 

ELSE  IF  ( TO(l:l)  . EQ . ’D'  ) THEN 

LRAREA 

61 

99 

RNUM  = VAL  ( FROM( 1:2)  ) 

LRAREA 

62 

00 

RAREA(RNUM)  = RAREA  (RNUM)  + WD IM ( R , 1 ) *WD IM (R , 2 ) 

LRAREA 

63 

0 1 

ELSE  IF  ((  FROM(l:l)  NE.  ‘D'  ) .AND.  ( TO ( 1 : 1 ) .NE. 

■D*  ))  THENLRAREA 

64 

02 

RNUM  = VAL  (FROMd  ; 2)  ) 

LRAREA 

65 

03 

RAREA(RNUM)  = RAREA  (RNUM)  + VD IM ( R , 1 ) *VD IM ( R , 2 ) 

LRAREA 

66 

04 

RNUM  = VAL  ( TOd  : 2)  ) 

LRAREA 

67 

05 

RAREA(RNUM)  = RAREA  (RNUM)  + WD IM ( R , 1 ) *WD IM( R , 2 ) 

LRAREA 

68 

06 

END  IE 

LRAREA 

69 

07 

END  IF 

LRAREA 

70 

08 

* 

LRAREA 

71 

09 

10  CONTINUE 

LRAREA 

72 

10 

RETURN 

LRAREA 

73 

1 1 

END 

LRAREA 

74 

--VARIABLE  MAP--(LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


FROM 

275B 

CHAR*3 

I 

301B 

INTEGER 

LAST 

272B 

INTEGER 

NEWWALL 

277B 

LOGICAL 

NEXT 

271B 

INTEGER 

NROOMS 

1 244B 

/ROOMN/ 

INTEGER 

R 

273B 

INTEGER 

RAREA 

1245B 

/ROOMN/ 

REAL 

RNUM 

274B 

INTEGER 

ROOM 

OB 

/ROOMN/ 

REAL 

TO 

276B 

CHAR»3 

WALL 

OB 

/WALLC/ 

CHAR*3 
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SUBROUTINE 

LRAREA 

74/175 

OPT  = 0 

UALLEND 

3 0 0B 

LOGICAL 

UDIM 

OB 

/WALLN/ 

REAL 

WERR 

3 4 2B 

/WALLN/ 

INTEGER 

WTOT 

34  IB 

/WALLN/ 

INTEGER 

-SYMBOLIC  CONSTANTS--! LO=A) 


-NAME TYPE VALUE 

RMAX  INTEGER  20 

VMAX  INTEGER  75 


-PROCEDURES--(LO=A) 

-NAME TYPE ARGS CLASS- -- 

VAL  INTEGER  1 FUNCTION 


-STATEMENT  L AB E LS- - ( LO= A ) 

-LAB  EL- ADDRESS PROPERTIES DEF 

5 INACTIVE  DO-TERM  60 

10  INACTIVE  DO-TERM  109 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS- -ARGS 

LRAREA  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

30  6B 

= 198 

CM  LABELLED  COMMON  LENGTH 

1 76  6B 

= 10  14 

CM  STORAGE  USED 

61000B 

= 25088 

COMPILE  TIME 

0.133 

SECONDS 
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1 SUBROUTINE  LROOM  (TS , TS 2 , FROM , TO  ) LROOM 

2 •[CCCCCCCLCCCCICCCCCCCLCCCCCCCCCCCCCCCCCLLCCCCCCCCCCLCCLLCCLCLCCCCCCEEECLROOM 

3 *[[(  CCCLROOM 

4 »•»  THIS  ROUTINE  LOADS  THE  TRANSMISSION  COEFFICIENT  INTO  THE  APPROPR I ATELROOM 

5 ***  LOCATION  IN  THE  'ROOM'  ARRAY.  LROOM 

6 »»•  LROOM 

7 »»*  NROOMS  TOTAL  NUMBERS  OF  ROOMS  REPRESENTED  BY  DATA  LROOM 

8 •*»  RMAX:  MAXIMUM  NUMBER  POSSIBLE  UNDER  THE  PRESENT  PROGRAM  CONF IGURATIOLROOM 

? TS  AND  TS2:  TRANSMISSION  COEFFICIENTS  LROOM 

10  »»»  FROM:  TO:  CONTAINS  ROOM# * S OR  THE  DIRECTIONS  D 1 , D2 , 4 , D5 , OR  D6 . LROOM 

11  »[[[  CCCLROOM 

12  * C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C C LROOM 

t * 1 

14  * « « * t 


*•*  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS 

INTEGER  RMAX 
PARAMETER  (RMAX  = 20) 

COMMON  /ROOMN/  ROOMCRMAX  + 6,  RMAX  + 6),  NROOMS,  RAREA(RMAX) 
INTEGER  NROOMS 
REAL  ROOM 

*«***««** 

***«««««* 

tt*n**t**ii**ii*ii**tii***t**tiit*tittttttiitt***t**tiitii*t 

* DECLARATION  OF  VARIABLES 

INTEGER  VAL,  C,  R,  RNUM,  D 
REAL  TS,  TS2 
CHARACTER  * 3 FROM,  TO 

***t*t***ii*tt**t*ii*t*tt**tttt*t**ii*****t*********t 

« 

IF  ( FROM( 1:1)  .EQ.  'D'  ) THEN 
RNUM  = VAL  ( TO(l : 2)  ) 

D = VAL  ( FROM (2: 2)  ) 

**********«***k***lt*lt**lt***lt*<t************)t*)t«i***lt 

* INSERT  TRANSMISSION  COEFFICENT  FOR  ENERGY  ENTERING  A ROOM  FROM  THE 

* OUTSIDE  OF  THE  BUILDING. 

t**t*t1t***t***t*t***fk***t*tt*ttt*ii**t***t*tt*t*t* 

R = NROOMS  + D 
C = RNUM 

ROOM(R,C)  = TS  + ROOM(R,C) 

* INSERT  TRANSMISSION  COEFFICIENT  INTO  'ROOM'  ARRAY  FOR  ENERGY  LEAVIl 

* A ROOM  TO  THE  OUTSIDE  OF  THE  BUILDING. 

*t*ttt*tt****t***tii**t*tt******t*tii**t*****t**t**t 

R = RNUM 
C = NROOMS  + D 

ROOM(R,C)  = TS2  / RAREA(RNUM)  + ROOM(R,C) 


53  ELSE  IF  ( T0<1:1)  .EQ.  'D'  ) THEN 

5 4 RNUM  = VAL  ( FROMd  :2)  ) 

55  D = VAL  ( TO(2 : 2)  ) 

56  **t*1t**IM<******)t******)i***1ilt*tA*4l*ilt)klt*t*k))*t*k*k)t* 

57  * INSERT  TRANSMISSION  COEFFICIENT  INTO  'ROOM'  ARRI 
* A ROOM  FROM  THE  OUTSIDE  OF  THE  BUILDING. 

thttttlitttttttlilituttttttlittttttttttttttttttlttttttt 

R = NROOMS  + D 
C = RNUM 

ROOM(R,C)  = TS  + ROOM(R,C) 

ttt*****iittii**t******ittii*tttt***ttt*tttt**t***t*** 


***COMR 

COMR 
COMR 
COMR 
COMR 
COMR 


58 

59 

60 
61 
62 

63 

64 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 
1 3 
1 
2 

3 

4 

5 

6 
7 
6 
9 


1 0 

LROOM 

15 

LROOM 

16 

LROOM 

17 

LROOM 

18 

LROOM 

19 

LROOM 

20 

LROOM 

21 

LROOM 

22 

LROOM 

23 

LROOM 

24 

LROOM 

25 

LROOM 

26 

LROOM 

27 

LROOM 

28 

LROOM 

29 

LROOM 

30 

LROOM 

31 

LROOM 

32 

LROOM 

33 

LROOM 

34 

LROOM 

35 

LROOM 

36 

LROOM 

37 

LROOM 

38 

LROOM 

39 

LROOM 

40 

LROOM 

41 

LROOM 

42 

LROOM 

43 

LROOM 

44 

LROOM 

45 

LROOM 

46 

LROOM 

47 

LROOM 

48 

LROOM 

49 

LROOM 

50 

LROOM 

51 

LROOM 

52 

LROOM 

53 

LROOM 

54 

LROOM 

55 
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65 

* 

A ROOM  TO  THE  OUTSIDE  OF  THE  BUILDING. 

LROOM 

56 

66 

* * 

*4i*«********«iit*ll**«**«**lt*«****«*lk*«***x*<ii>***** 

LROOM 

57 

67 

R = RNUM 

LROOM 

58 

68 

C = NROOMS  + D 

LROOM 

59 

69 

ROOM(R,C)  = TS2  / RAREA(RNUM)  + ROOM(R,C) 

LROOM 

60 

70 

* * 

xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx 

LROOM 

61 

71 

t 

LROOM 

62 

72 

h * 

xxxxxxxxxxxxxxtxxxxxxxxxxxxxxxxxxxxxxxxxxxxtxxx* 

LROOM 

63 

73 

ELSE 

LROOM 

64 

74 

* * 

*x**xx****xx*xxx*xxx*xx*xx***x**«*x*x.xx«xxitx*x** 

LROOM 

65 

75 

t 

INSERT  TRANSMISSION  COEFFICIENTS  INTO  'ROOM'  ARRAY  FOR  ENERGY  GOIN 

LROOM 

66 

76 

it 

FROM  ROOM  TO  ROOM. 

LROOM 

67 

77 

t * 

xx*xxxxxxxxxx*x*x*«xx*xxxxxxx**x*x****x*xxxxxxxx 

LROOM 

68 

78 

R = VAL  ( FROMd  : 2)  ) 

LROOM 

69 

79 

C = VAL  ( TO( 1 : 2)  ) 

LROOM 

70 

80 

ROOM(R,C)  = TS2  / RAREA(R)  + ROOM(R,C) 

LROOM 

71 

81 

ROOM(C,R)  = TS2  / RAREA(C)  + ROOM(C,R) 

LROOM 

72 

82 

END  IF 

LROOM 

73 

83 

RETURN 

LROOM 

7 4 

84 

END 

LROOM 

75 

VARIABLE 

MAP-- 

(LO=A) 

NAME---ADDRESS 

--BLOCK PROPERTIES 

TYPE 

C 

2 2 2B 

INTEGER 

D 

2 2 5E 

INTEGER 

FROM 

3 

DUMMY-ARG 

CHAR*3 

NROOMS 

1 2 4 4B 

/ROOMN/ 

INTEGER 

R 

223B 

INTEGER 

RAREA 

1 245B 

/ROOMN/ 

REAL 

RNUM 

2 2 4B 

INTEGER 

ROOM 

OB 

/ROOMN/ 

REAL 

TO 

4 

DUMMY-ARG 

CHAR*3 

TS 

1 

DUMMY-ARG 

REAL 

TS2 

2 

DUMMY-ARG 

REAL 

-SYMBOLIC  CONSTANTS--! LO=A) 


-NAME TYPE VALUE 

RMAX  INTEGER  20 


-PROCEDURES--(LO=A) 

-NAME TYPE--- ARGS CLASS--- 

VAL  INTEGER  1 FUNCTION 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS- -- 

LROOM  5B  4 
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--STATISTICS-- 


PROCRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


230B  = 152 

1271B  = 697 

61000B  = 25088 

0.100  SECONDS 
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29 


FTN  5 1+552 
FUNCTION  VAL 


1 

INTEGER  FUNCTION  VAL(STRING 

) 

LROOM 

76 

2 

*CC 

t 

[[[[[[[[[[[[[[[[[[[[[[tCCCCCC 

C C [ [ 

[[[[[[[[[[[[[[[ 

[[[[[[[CttCCCICICUtLROOM 

77 

3 

c 

[[[LROOM 

78 

4 

*C  C 

[ 

RETURNS  THE  INTEGER  VALUE 

OF  A 

STRING . 

[[[LROOM 

79 

5 

*[  [ 

[ 

[ [ [LROOM 

80 

6 

*[[ 

c 

[[[[[[[[[[[[[[[CtCCCCCCCIFtCI 

[CCC 

CCCCItCCCICCtIC 

[[[[[[[[[[[[[[[[[[[[LROOM 

81 

7 

* It  Hr 

* 

**«***«*ti*ii*it*«************** 

It  It  It  * 

tut************* 

«itii*it«iititit*iiiiititititttit**  LROOM 

82 

8 

INTEGER  NUMBER,  X,  L,  EXP, 

DIG 

IT,  GETLEN 

LROOM 

83 

9 

CHARACTER  » (*)  STRING 

LROOM 

84 

10 

t 

LROOM 

85 

11 

L = GETLEN(STRING) 

LROOM 

86 

12 

NUMBER  = 0 

LROOM 

87 

13 

DO  10  X = L,  1 , -1 

LROOM 

88 

14 

EXP  = L - X 

LROOM 

8? 

15 

DIGIT  = ICHAR(STRING(X: X) 

) - 

16 

LROOM 

90 

1 6 

NUMBER  = NUMBER  + DIGIT*1 

0**EXP 

LROOM 

91 

17 

10 

CONTINUE 

LROOM 

92 

18 

VAL  = NUMBER 

LROOM 

93 

19 

RETURN 

LROOM 

94 

20 

END 

LROOM 

95 

-VARIABLE  MAP--(LO=A) 

-NAME---ADDRESS--BLOCK PROPERTIES 

TYPE 

DIGIT 

76B 

INTEGER 

EXP 

75B 

INTEGER 

L 

74B 

INTEGER 

NUMBER 

72B 

INTEGER 

STRING 

1 DUMMY-ARG 

CHAR*( *) 

VAL 

71B 

INTEGER 

X 

73B 

INTEGER 

-PROCEDURES--(LO=A) 

-NAME TYPE AHGS CLASS 

GETLEN  INTEGER  1 FUNCTION 

ICHAR  INTEGER  1 INTRINSIC 


-STATEMENT  LABELS- -( LO= A ) 

-LABEL -ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  17 


-ENTRY  POINTS--(LO=A) 
-NAME---ADDRESS--ARGS 

VAL  6B  1 


-STATISTICS-- 

PROGRAM-UNIT  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


102B  = 66 

61000B  = 25088 

0.039  SECONDS 
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1 

INTEGER  FUNCTION  GETLEN  (STRING) 

LROOM 

96 

2 

C C C C C C [ C [ C [ C C [ C [ C C [ [ C [ [ C t [ [ C C C [ C C C C C [ C C C C C [ [ [ C [ C C [ [ [ C C C [ C C [ C C C [ [ [ C C C C [ [ LROOM 

97 

3 

C [ [ 

[ C [LROOM 

98 

4 

ICC  DETERMINE  LENGTH  OF  STRING  EXCLUDING  ANY  BLANK  PADDING 

[ [[LROOM 

99 

5 

[ [ C 

[ [ [LROOM 

100 

i 

t C C [[[[[[[[[  C C C [ C C [[  C C [ C [[[  C C C C C C [[[ C [ LC  C [ C C C C [ C [[[[ C C C [ C C C [ C [[[ C C C C [ [ [LROOM 

1 01 

7 

t»»**»»»»»»**»»*»*»»*»»»***»»*****»**»»***»»**»**jMi»*»*»»*»*»*»*»t**»*»LROOI'l 

102 

8 

LROOM 

1 03 

9 

ARGUMENT  DEFINITIONS  -- 

LROOM 

104 

10 

INPUT  ARGUMENTS 

LROOM 

1 05 

1 1 

STRING  - STRING  WHOSE  LENGTH  IS  TO  BE  DETERMINED 

LROOM 

106 

12 

LROOM 

1 07 

13 

LROOM 

108 

1 4 

CHARACTER  * (*)  STRING 

LROOM 

109 

15 

LROOM 

no 

U 

FUNCTION  PARAMETERS 

LROOM 

1 11 

17 

LROOM 

1 1 2 

1 8 

CHARACTER  * 1 BLANK 

LROOM 

1 13 

19 

PARAMETER  (BLANK  = ' ' ) 

LROOM 

114 

20 

AAAAAAAAAAAAAAAAAAAAAAAAAAAA*A*****AA*A**«*AAAAAA 

LROOM 

1 15 

21 

LOCAL  VARIABLES 

LROOM 

1 1 6 

22 

AAAAAAAAAAAAAAAAAAAAAAA«AAAAAA*A*AAA*AA*«AAAtt*AA 

LROOM 

1 17 

23 

INTEGER  NEXT 

LROOM 

1 1 8 

24 

AAAAAAAAAAAAAAAAAA*AAAA**lkAA*A*A**AAA*AA«AAAAA*AA 

LROOM 

1 19 

25 

START  WITH  THE  LAST  CHARACTER  AND  FIND  THE  FIRST  NON-BLANK 

LROOM 

120 

26 

AAAAAAAAAAAAAAAAAAAAAAAA«AAA*A*AAAAAAA*AAA*AAAAAA 

LROOM 

121 

27 

DO  10  NEXT  = LEN(STRING) , 1 , -1 

LROOM 

122 

28 

IF  (STRING(NEXT  ; NEXT)  .NE.  BLANK)  THEN 

LROOM 

123 

29 

GETLEN  = NEXT 

LROOM 

124 

30 

RETURN 

LROOM 

1 25 

31 

END  IF 

LROOM 

126 

32 

10  CONTINUE 

LROOM 

1 27 

33 

LROOM 

128 

34 

* 

ALL  CHARACTERS  ARE  BLANKS 

LROOM 

1 29 

35 

LROOM 

130 

36 

GETLEN  = 0 

LROOM 

131 

37 

A 

LROOM 

132 

38 

RETURN 

LROOM 

1 33 

39 

END 

LROOM 

134 

-VARIABLE  MAP--(LO=A) 

-NAME---ADDRESS--BLOCK PROPERTIES 

TYPE 

---SIZE 

GETLEN 

63B 

INTEGER 

NEXT 

64B 

INTEGER 

STRING 

1 DUMMY-ARG 

CHAR*( *) 

-SYMBOLIC  CONSTANTS-- (LO=A) 

-NAME TYPE VALUE 

BLANK  CHAR*1  ' ' 


-PROCEDURES 

•< 

tl 

o 

1 

1 

-NAME 

TYPE 

--ARGS 

CLASS 

LEN 

INTEGER 

1 

INTRINSIC 
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-STATEMENT  LABELS-- ( LO=A ) 

-LAB  EL -ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  32 


-ENTRY  POINTS--(LO=A) 
-NAME ---ADDRESS- -ARCS- -- 

GETLEN  6B  1 


-STATISTICS-- 

PROGRAM-UNIT  LENGTH  70B 
CM  STORAGE  USED  61000B 
COMPILE  TIME  0 . 039 


3 PAGE  31 


= 56 

= 25088 

SECONDS 
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SUBROUTINE  LTDB  74/175  OPT=0 

1 SUBROUTINE  LTDB  LTDB  1 

2 • C C [ I [ [ C [ C C [ C [ C [ C C C [ [ [ [ C C C [ [ [ C [ [ C C C C C [ C [ [ C [ t [ [ [ C [ C [ C [ [ C C C [ C [ C [ [ C [ C C C C C [ C LTDB  2 

3 •[[[  [[[LTDB  3 

4 *[[[  THIS  ROUTINE  CALCULATES  THE  ATTENUATION  OF  EACH  DOOR  AND  [[[LTDB  4 

5 »[[[  WINDOW  [[[LTDB  5 

i •[[[  [[[LTDB  6 

7 «[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [ [LTDB  7 

9 * VARIABLE  DEFINITIONS  LTDB  9 

10  » ID;  IDENTIFICATION  OF  OPENING  LTDB  10 

11  • OATTEN:  OPENING  ATTENUATION  LTDB  11 

12  • LATTEN:  LAYER  ATTENUATION  LTDB  12 

13  » MATTEN;  MATERIAL  ATTENUATION  LTDB  13 

14  * MAT:  MATERIAL  IDENTIFICATION  LTDB  14 

15  * TDBTOT:  TOTAL  LINES  OF  DATA  IN  THE  TDBl  AND  TDB2  ARRAYS  LTDB  15 

U » HEIGHT:  HEIGHT  OF  DOOR  OR  WINDOW  OPENING  LTDB  16 

17  * WIDTH:  WIDTH  OF  DOOR  OR  WINDOW  LTDB  17 

18  » T;  THICKNESS  OF  LAYER  LTDB  18 

19  • AREA:  AREA  LTDB  19 

20  * NEWTYPE:  TRUE  IF  DATA  LINE  BELONGS  TO  A NEW  DOOR  OR  WINDOW  TYPE  LTDB  20 

21  • TYPEEND:  TRUE  IF  DATA  LINE  IS  THE  LAST  DATA  LINE  OF  AN  OPENING  TYPE  LTDB  21 

24  ***  COMMON  FOR  INITIAL  PARAMETERS  »**COMF  2 

26  INTEGER  FMAX  COMF  4 

27  PARAMETER  (FMAX  = 50)  COMF  5 

28  COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX),  FERR,  COMF  6 

29  $ FTOT  COMF  7 

30  COMMON  /INITILC/  BLDG  COMF  8 

31  CHARACTER  * 5 BLDG  COMF  9 

32  REAL  FREQ,  AFLAG,  RFLAG,  FREQA  COMF  10 

33  INTEGER  QUALITY,  FERR,  FTOT  COMF  11 

37  ***  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  ***COMT  2 

39  INTEGER  TMAX  COMT  4 

40  PARAMETER  (TMAX=35)  COMT  5 

41  COMMON  /TYPEN/TDIM(TMAX,4) ,TTOT,TDB2(TMAX,2) ,TDBTOT,TERR  COMT  6 

42  COMMON  /TYPEC/TYPE(TMAX , 3) ,TDB1 (TMAX)  COMT  7 

43  INTEGER  TTOT , TDBTOT , TERR  COMT  8 

44  REAL  TDIM,TDB2  COMT  9 

45  CHARACTER  * 3 TYPE, TDBl  COMT  10 

46  *=================================================  COMT  11 

47  * DESCRIPTION  OF  ARRAYS  COMT  12 

48  »=================================================  COMT  13 

49  * ID  MATERIAL  FRAME  MATERIAL  COMT  14 

50  * COMT  15 

51  *TYPE(X,1)  TYPE(X,2)  TYPE(X,3)  COMT  16 

52  * A3  A3  A3  COMT  17 

53  *=================================================  COMT  18 

54  * HEIGHT  WIDTH  LAYER  DISTANCE  COMT  19 

55  * THICKNESS  ABOVE  FLOOR  COMT  20 

54  * COMT  21 

57  * TDIM(X,1)  TDIM(X,2)  TDIM(X,3)  TDIM(X,4)  COMT  22 

58  * F8.2  F8.2  F8.2  F8 . 2 COMT  23 

59  *=================================================  COMT  24 

60  * ID  ATTENUATION  AREA  COMT  25 

41  * COMT  2 6 

62  * TDBKX)  TDB2(X,1)  TDB2(X,2)  COMT  27 

63  * A3  E9.3  E9.3  COMT  28 

44  ********************»**«*«t*tt«************«»*t******«********t<i«******t«tcOMT  29 
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65 

66 

67 

68 

69 

70 

71 

72 

73 

74 

75 

76 

77 

78 

79 

80 
81 
82 

83 

84 

85 

86 

87 

88 

89 

90 

91 

92 

93 

94 

95 

96 

97 

98 

99 
100 
101 
102 

103 

104 

105 

106 

107 

108 
109 

no 

111 

112 

113 

114 

115 

116 

117 

118 

119 

120 
121 
122 

123 

124 

125 

126 

127 

128 


************1Hl*t1tt*t*t*1l*1ltt*1t1l*1lt**1l*tt*t**t*1l*tt 

* DECLARATION  OF  VARIABLES 

rt**********************************)*************** 

INTEGER  NEXT,  LAST,  R 
REAL  LATTEN,  OATTEN,  MATTEN,  ATTEN 
REAL  HEIGHT,  WIDTH,  AREA 
CHARACTER  * 3 MAT  , ID 
LOGICAL  NEWTYPE,  TYPEEND 

***«******lM(«k«i**«i)l*«****lk****lk****«r***«*»*Klt*ik*«* 

*«**ik***«ili«Mk***<i<t********«*«*«**tt****A******1tIkAAIt* 

TDBTOT  = 0 

DO  10  R = 1,  TTOT 

t****t*ii*t*iit**»ii*ii*ii»iitii*itt***t****tttii*titiittitii** 

* SET  TYPEEND  CONDITION 

t**iiiit****t*ii***tiiii**iiiit***tt*lt*iit***itt**ttitttitt*t 

NEXT  = R + 1 
IF  (R  .EQ.  TTOT)  THEN 
TYPEEND  = .TRUE. 

ELSE  IF  ( TYPE(R,1)  .NE.  TYPE<NEXT,1)  ) THEN 
TYPEEND  = .TRUE. 

ELSE 

TYPEEND  = .FALSE. 

END  IF 

*4t*******lii*ikttilr**ik**4i**ltllr***A******lt**<t***)t*)k<ltMt*lt* 

« SET  NEVTYPE  CONDITION 

*f[*«1li«***i>tt***A****A**1k***A«AAftAA*t***AA********** 

LAST  = R - 1 
IF  (R  EQ.  1)  THEN 
NEWTYPE  = .TRUE. 

ELSE  IF  ( TYPE(R,1)  .NE.  TYPE(LAST,1)  ) THEN 
NEWTYPE  = .TRUE. 

ELSE 

NEWTYPE  = .FALSE. 

END  IF 

*********lt**«**A*****t*lk****1t**it*]t**«ik1t**«**ltK***tt 

* CALCULATE 

IF  (NEWTYPE)  THEN 

* ..INITIALIZE  TYPE  CONDITIONS 

OATTEN  = 0 
END  IF 

**lt*lk***tt*«r*lt*t*1tlt4ilt*lt***t)tk*****ltik**lt********tk**lk* 

* ...CALCULATE  ATTENUATION  FACTOR  OF  LAYER 

**Aiit*********ilc**A********ft**Aft*****ik*tAt****t4tftft*1k 

MAT  = TYPEIR, 2) 

MATTEN  = ATTEN  (MAT , FREQ , AFLAG ) 

T = TDIMCR, 3) 

LATTEN  = MATTEN  * T 

* ..CALCULATE  RUNNING  ATTENUATION  FACTOR  OF  OPENING 
************************************************** 

OATTEN  = OATTEN  + LATTEN 
IF  (TYPEEND)  THEN 

4(tt***<i****ltiii*lt***k********<k<i*lk*****tilMt**lk*<lli****** 

* ....CALCULATE  TOTAL  OPENING  AREA 

*t**********Aik****lit***l(*ftk****1kllt******A***A****«** 

HEIGHT  = TDIM(R, 1 ) 

WIDTH  = TDIM(R,2) 

AREA  = HEIGHT  * WIDTH 

*t*t*t***t1i****1i***1(*1itlt*li1i1i1i*1itli*t*1i1i*1rk1i**1i*1i*ii* 
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28 
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29 
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30 
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31 

LTDB 

32 

LTDB 

33 

LTDB 

34 
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37 
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LTDB 

43 

LTDB 

44 

LTDB 

45 
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54 

LTDB 

55 

LTDB 

56 

LTDB 

57 

LTDB 

58 

LTDB 

59 

LTDB 

60 

LTDB 

61 

LTDB 

62 

LTDB 

63 

LTDB 

64 

LTDB 

65 

LTDB 

66 

LTDB 

67 

LTDB 

68 

LTDB 

69 

LTDB 

70 

LTDB 

71 

LTDB 

72 

LTDB 

73 

LTDB 

74 

LTDB 

75 

LTDB 

76 
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77 
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78 

LTDB 

79 
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80 
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81 
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1 29 

* INSERT  ID,  ATTENUATION  AND  AREA  INTO  TYPE  DATABASE  ARRAYS 

LTDB 

88 

130 

t************************************************* 

LTDB 

89 

13  1 

TDBTOT  = TDBTOT  + 1 

LTDB 

90 

132 

ID  = TYPE(R,1) 

LTDB 

91 

133 

TDBl (TDBTOT)  = ID 

LTDB 

92 

134 

TDB2 (TDBTOT , 1 ) = OATTEN 

LTDB 

93 

135 

TDB2(TDBTOT, 2)  = AREA 

LTDB 

94 

136 

END  IF 

LTDB 

95 

137 

10  CONTINUE 

LTDB 

96 

138 

RETURN 

LTDB 

97 

139 

END 

LTDB 

98 

VARIABLE 

MAP-- 

(LO=A) 

■NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

---SIZE 

AFLAC 

2B 

/ INITILN/ 

REAL 

AREA 

22  IB 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/INITILN/ 

REAL 

50 

FTOT 

676 

/ INITILN/ 

INTEGER 

HEIGHT 

217B 

REAL 

ID 

22  3B 

CHAR*3 

LAST 

212B 

INTEGER 

LATTEN 

214B 

REAL 

MAT 

222B 

CHAR*3 

MATTEN 

216B 

REAL 

NEWTYPE 

22  4B 

LOGICAL 

NEXT 

21  IB 

INTEGER 

OATTEN 

215B 

REAL 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

213B 

INTEGER 

RFLAG 

3B 

/ INITILN/ 

REAL 

T 

22  7B 

REAL 

TDBTOT 

32  36 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

140 

TERR 

324B 

/TYPEN/ 

INTEGER 

TTOT 

214B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

1 05 

TYPEEND 

225B 

LOGICAL 

WIDTH 

22  0B 

REAL 

-SYMBOLIC  CONSTANTS--(LO=A) 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

TMAX  INTEGER  35 


-PROCEDURES--(LO=A) 


-NAME 

---TYPE 

ARCS--- 

CLASS 

ATTEN 

REAL 

3 

FUNCTION 
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-STATEMENT  LABELS-- ( LOuA ) 

-LAB  EL -ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  137 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS 

LTDB  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

232B 

= 154 

CM  LABELLED  COMMON  LENGTH 

470B 

= 312 

CM  STORAGE  USED 

81000B 

= 25088 

COMPILE  TIME 

0.114 

SECONDS 
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1 SUBROUTINE  LTYPE  LTYPE 

2 » [ [ [ [ [ C C [ C [ C I [ C C [ C [ [ [ C C C [ C C [ [ I [ [ C C C [ C C C C [ [ [[ C CC [ C [ [ C [[ C [ C [ C [ C C [ C C C C C C [ [ [LTYPE 

3 *[[[  [[[LTYPE 

4 *[[[  LOAD  THE  "TYPE"  ARRAYS  FROM  THE  TYPE  DATA  FILE  [[[LTYPE 

5 *[[[  [[[LTYPE 

6 *[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[[[[[[[ [[LTYPE 

S t***********************************************************************  COMT 
9 ***  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  ***COMT 

10  ltli<i*ll<i*lk*4i*****)i*lt********t*kA*ktl****tlt***<ilt«i**tt**tt*<ilt«lkiii**ltAlt**tl****lt*4i<((^  OMT 

11  INTEGER  TMAX  COMT 

12  PARAMETER  (TMAX=35)  COMT 

13  COMMON  /TYPEN/TDIM(TMAX,4) ,TTOT,TDB2(TMAX,2> ,TDBTOT,TERR  COMT 

14  COMMON  /TYPEC/TYPE(TMAX , 3) ,TDB1 (TMAX)  COMT 

15  INTEGER  TTOT , TDBTOT , TERR  COMT 

16  REAL  TDIM.TDB2  COMT 

17  CHARACTER  * 3 TYPE.TDBl  COMT 

18  *==============:===================================  COMT 

19  * DESCRIPTION  OF  ARRAYS  COMT 

20  *=================================================  COMT 

21  * ID  MATERIAL  FRAME  MATERIAL  COMT 

22  » COMT 

23  *TYPE(X,1)  TYPE(X,2)  TYPE(X,3)  COMT 

24  » A3  A3  A3  COMT 

25  *=================================================  COMT 

26  * HEIGHT  WIDTH  LAYER  DISTANCE  COMT 

27  * THICKNESS  ABOVE  FLOOR  COMT 

28  * COMT 

29  * TDIM(X,1)  TDIM(X,2)  TDIM(X,3)  TDIM(X,4)  COMT 

30  * F8.2  F8.2  F8.2  FB . 2 COMT 

31  *=================================================  COMT 

32  * ID  ATTENUATION  AREA  COMT 

33  * COMT 

34  * TDBl(X)  TDB2(X,1)  TDB2(X,2)  COMT 

35  ♦ A3  E9.3  E9.3  COMT 

39  ***  COMMON  FOR  INITIAL  PARAMETERS  ***COMF 

41  INTEGER  FMAX  COMF 

42  PARAMETER  (FMAX  = 50)  COMF 

43  COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX),  FERR,  COMF 

44  5 FTOT  COMF 

45  COMMON  /INITILC/  BLDG  COMF 

46  CHARACTER  * 5 BLDG  COMF 

47  REAL  FREQ,  AFLAG,  RFLAG,  FREQA  COMF 

48  INTEGER  QUALITY,  FERR,  FTOT  COMF 

51  **************************************************  LTYPE 

52  * DECLARATION  OF  VARIABLES  LTYPE 

53  **************************************************  LTYPE 

54  INTEGER  GETLEN,  R,  C LTYPE 

55  CHARACTER  * 7 PFN  LTYPE 

5^  ***  *t  **  tt  tit  * t ******  ***ii  tt  ***  ii  * t ******  *t  **********  * LTYPE 

57  * LTYPE 

58  **************************************************  LTYPE 

59  PFN  = 'B'  II  BLDGd  :GETLEN(BLDG)  ) II  'T’  LTYPE 

60  TERR  = 0 LTYPE 

61  CALL  PF  ( 'GET' ,0,PFN(1ETLEN(PFN) ), ‘RC , TERR)  LTYPE  20 

62  IF  (TERR  .EQ.  0 ) THEN  LTYPE 

63  OPEN  (UNIT=3,  FILE=PFN,  FORM= ' FORMATTED ' , LTYPE 

64  S STATUS='OLD' , ACCESS= ' SEQUENTI AL ' ) LTYPE 


1 

2 

3 

4 

5 

6 

7 

1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

1 2 

13 

14 

15 

1 6 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

1 

2 

3 

4 

5 

6 

7 

8 

9 

1 0 

1 1 

1 2 

13 

10 

11 

1 2 

13 

1 4 

15 

1 6 

17 

1 8 

19 

2 1 

22 

23 
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65 

1000 

FORMAT  (1X,3(1X,A3),4(1X,F8.2) > 

LTYPE 

24 

66 

TTOT  = 0 

LTYPE 

25 

67 

DO  10  R = l.TMAX 

LTYPE 

26 

68 

READ  (3,1000, END=20) (TYPE(R ,C) ,C=1,3),(TDIM(R,C),C=1,4) 

LTYPE 

27 

69 

TTOT  = TTOT  + 1 

LTYPE 

28 

70 

10 

CONTINUE 

LTYPE 

29 

71 

20 

CONTINUE 

LTYPE 

30 

72 

CLOSE(3,STATUS='DELETE‘ > 

LTYPE 

31 

73 

ELSE  IF  ( TERR  EQ.  2 ) THEN 

LTYPE 

32 

74 

CALL  WARNING  (5) 

LTYPE 

33 

75 

ELSE 

LTYPE 

34 

76 

CALL  WARNING  (6) 

LTYPE 

35 

77 

END  IF 

LTYPE 

36 

78 

RETURN 

LTYPE 

37 

79 

END 

LTYPE 

38 

-VARIABLE  MAP--(LO=A) 


-NAME--- 

ADDRESS- 

-BLOCK  PROPERTIES 

TYPE 

---SIZE 

AFLAC 

28 

1 INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

C 

236B 

INTEGER 

FERR 

66B 

/INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTOT 

67B 

/ INITILN/ 

INTEGER 

PFN 

237B 

CHAR*7 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

235B 

INTEGER 

RFLAG 

3B 

/ INITILN/ 

REAL 

TDBTOT 

323E 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

1 40 

TERR 

324B 

/TYPEN/ 

INTEGER 

TTOT 

214B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC / 

CHAR*3 

105 

-SYMBOLIC  CONSTANTS--(LO=A) 

-NAME TYPE VALUE 

FMAX  INTEGER  50 

TMAX  INTEGER  35 


-PROCEDURES--(LO=A) 

-NAME TYPE ARGS CLASS 

GETLEN  INTEGER  1 FUNCTION 

PF  5 SUBROUTINE 

WARNING  1 SUBROUTINE 


-STATEMENT  LABELS--! LO=A) 


LABEL- 

ADDRESS 

--PROPERTIES 

-DEF 

10 

INACTIVE 

DO-TERM 

70 

20 

lllB 

71 

1000 

147B 

FORMAT 

65 
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-ENTRY  POINTS--(LO=A) 

-NAME ADDRESS --ARCS 

LTYPE  5B  0 


-1 10  UNITS--(LO=A) 
-NAME PROPERTIES- 

TAPE3  AUX/FMT/SEQ 


-STATISTICS-- 


PROCRAM-UNIT  LENGTH 

24  5B 

= 185 

CM  LABELLED  COMMON  LENGTH 

47  0B 

= 3 12 

CM  STORAGE  USED 

83000B 

= 26112 

COMPILE  TIME 

0.103 

SECONDS 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 
1 6 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 
38 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


SUBROUTINE  LWALL  LWALL 

meet  U[[[CCt[[CC[[[[[[[C[[CC[[[C[[[[[CCCt[[[[tCC[C[C[[[[[C[[[[[[[[[t  [[LWALL 
*[[[  [[[LWALL 

*[[[  LOAD  THE  CONTENTS  OP  THE  FILE  'WALLS'  INTO  ARRAYS  WALL  AND  WDIM.  LWALL 
*[[[  [[[LWALL 

*[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[[[[LWALL 
««******«**««i4M»**«ik*****«*««r*****«*****«t*******itik*«**«r**«*lk**ltt**lt******  LWALL 

***  COMMON  FOR  DATABASE  OF  WALL  PARAMETERS  ***COMW 

Ik  * A A 1 


INTEGER  WMAX 
PARAMETER  (WMAX  = 75) 

COMMON  /WALLN/  WDIM(WMAX,3) 
COMMON  /WALLC/  WALL (WMAX, 4) 
INTEGER  WTOT.WERR 
REAL  WDIM 
CHARACTER  *3  WALL 
* ===============================: 

*»  DESCRIPTION  OF  ARRAYS 

* WALL  IDENTIFICATION 

* 

« 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* 

* * 


WTOT,  WERR 


DIRECTION 

FROM 

ROOM 

TO 

ROOM 

WALL (X , 1 ) 
A3 

WALL(X,2) 

A3 

WALL(X,3) 

A3 

WALL  PARAMETERS 

MATERIAL 

HEIGHT 

WIDTH 

LAYER  THICKNESS 

WALL( X, 4) 

WDIM( X, 1 ) 

WDIM(X, 2) 

WDIM(X, 3) 

A3 

F8  . 2 

F8  .2 

FB  . 2 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 

COMW 


***  COMMON  FOR  INITIAL  PARAMETERS 

«*  ** 

INTEGER  FMAX 
PARAMETER  (FMAX  = 50) 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR 
$ FTOT 

COMMON  /INITILC/  BLDG 
CHARACTER  * 5 BLDG 
REAL  FREQ,  AFLAC,  RFLAG,  FREQA 
INTEGER  QUALITY,  FERR,  FTOT 

*******<l**t)lktl**««lt***IMt*lk***<t***************ltlk**** 

* DECLARATION  OF  VARIABLES 

t*t*t*******it****t**t******itii*ii*ti***t***iit*tt*ii*tt 

INTEGER  GETLEN,  R,  C 
CHARACTER  * 7 NAME,  PFN 

************************************************** 

* 

NAME  = ' B ' / /BLDG( 1 ; GETLEN(BLDG) ) / / ' W' 

PFN  = NAME  ( 1 : GETLEN(NAME) ) 

WERR  = 0 

CALL  PF  (' GET' , 0 , PFN( lETLEN(PFN) ),' RC ', WERR) 

IF  ( WERR  EQ.  0 ) THEN 

OPEN  (UNIT=3,  FILE=PFN,  FORM= ' FORMATTED ' , 

5 STATUS= 'OLD ' , ACCESS= ' SEQUENTI AL ' ) 


*«*COMF 

COMF 
COMF 
COMF 
COMF 
COMF 
COMF 


1 

2 

3 

4 

5 

6 
7 
1 
2 

3 

4 

5 

6 

7 

8 
9 

1 0 
11 
1 2 
13 
1 4 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 
29 

1 

2 

3 

4 

5 

6 
7 


COMF 

10 

COMF 

11 

12 

13 

LWALL 

10 

LWALL 

1 1 

LWALL 

12 

LWALL 

13 

LWALL 

14 

LWALL 

15 

LWALL 

16 

LWALL 

17 

LWALL 

18 

LWALL 

19 

LWALL 

20 

'ALL 

21 

LWALL 

22 

LWALL 

23 

LWALL 

24 
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40 


&5 

1000 

FORMAT  ( IX  , 4(  IX,  A3  ) , 3( IX , F8  . 2)  ) 

LWALL 

25 

&& 

WTOT  = 0 

LWALL 

26 

67 

DO  10  R = 1,UMAX 

LWALL 

27 

68 

READ  (3,1000, END=20) (WALL(R,C) ,C=1,4),(WDIM(R,C),C=1,3) 

LWALL 

28 

69 

WTOT  = WTOT  + 1 

LWALL 

29 

70 

10 

CONTINUE 

LWALL 

30 

71 

20 

CONTINUE 

LWALL 

3 1 

72 

CLOSE (3 ,STATUS=' DELETE’ ) 

LWALL 

32 

73 

ELSE  IF  ( WERR  .EQ.  2 ) THEN 

LWALL 

33 

74 

CALL  WARNING  (7) 

LWALL 

34 

75 

ELSE 

LWALL 

35 

76 

CALL  WARNING  (8) 

LWALL 

36 

77 

END  IF 

LWALL 

37 

78 

RETURN 

LWALL 

38 

79 

END 

LWALL 

39 

-VARIABLE 

MAP-- 

(LO=A) 

-NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

SIZE 

AFLAG 

2B 

/ INITILN/ 

REAL 

BLOG 

OB 

/ INITILC/ 

CHAR*5 

C 

255B 

INTEGER 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTOT 

67B 

/ INITILN/ 

INTEGER 

NAME 

25  6B 

CHAR*7 

PFN 

25  7B 

CHAR*7 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

2 5 4B 

INTEGER 

RFLAG 

3B 

/ INITILN/ 

REAL 

WALL 

OB 

/WALLC/ 

CHAR*3 

300 

WDIM 

OB 

/WALLN/ 

REAL 

225 

WERR 

342B 

/WALLN/ 

INTEGER 

WTOT 

341B 

/WALLN/ 

INTEGER 

-SYMBOLIC  CONSTANTS--(LO=A) 

-NAME TYPE VALUE 

FMAX  INTEGER  50 

WMAX  INTEGER  75 


-PROCEDURES--(LO=A> 

-NAME TYPE ARGS CLASS 

GETLEN  INTEGER  1 FUNCTION 

PF  5 SUBROUTINE 

WARNING  1 SUBROUTINE 


-STATEMENT  LABELS--! LO=A) 


LABEL 

-ADDRESS 

--PROPERTIES-- 

--DEF 

1 0 

INACTIVE 

DO-TERM 

70 

20 

117B 

71 

1000 

155B 

FORMAT 

65 
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-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS 

LWALL  5B  0 


-I /O  UNITS--(LO=A) 
-NAME---  PROPERTIES- 

TAPE3  AUX/FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH  265B 
CM  LABELLED  COMMON  LENGTH  566B 
CM  STORAGE  USED  63000B 
COMPILE  TIME  0.108 


= 181 
= 374 

= 26112 
SECONDS 
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42 


1 

2 

3 

4 

5 
8 

7 

8 
9 

10 
1 1 
12 
13 
1 4 
IS 
1 6 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 


SUBROUTINE  PHOLE  PHOLE 
•CCCC[[CC[CCCCCC[CC[CUC[[CC[[CCC[CCC[[CC[[[[C[CC[CC[C[[C[[[[[CC[C[[CCC[PHOLE 
•[[[  [[[PHOLE 
•[[[  PRINT  OUT  THE  CONTENTS  OF  THE  HOLE  ARRAY  [[[PHOLE 
»[[[  [[[PHOLE 
•[([[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[PHOLE 


«*«t*««**«*******««**«i 

»*»  COMMON  FOR  DATABASE  OF  LOCATIONS  OF  DOORS  AND  WINDOWS  *»*COMH 

*******«*t«****«****«*«««*«**********»*****************it**************«*COMH 


INTEGER  HMAX 
PARAMETER  (HMAX  = 35) 

COMMON  /HOLEN/  HTOT,  HERR 
COMMON  /HOLEC/  HOLE (HMAX, 4) 
INTEGER  HTOT,  HERR 
CHARACTER  » 3 HOLE 


COMH 


DESCRIPTION 

OF  ARRAYS 

ROOM  IDENTIFICATION 

APERTURE 

ID 

DIRECTION 

FROM  ROOM 

TO  ROOM 

HOLE(X, 1) 
A3 

HOLE(X,2) 

A3 

HOLE (X, 3 ) 
A3 

HOLE (X 
A3 

,4) 

* : 

INTEGER  R,C 
PRINT  * 

PRINT  DOOR  AND  WINDOW  LOCATIONS' 

PR  I NT* , '***************************' 

PRINT*,'  WALL  IDENTIFICATION' 

PRINT*,'  ' 

PRINT*,'  ID  DIRECTION  FROM  TO' 
PRINT*, '====  ======================' 

DO  10  R = 1 ,HTOT 

PRINT  1000 .HOLE (R, 4) , (HOLE(R,C) ,C=1 , 3) 
10  CONTINUE 

PRINT* , '===========================■ 

1000  FORMAT  ( 2X , A3 , 5X , 3 ( 3X , A3 ) ) 

RETURN 

END 


COMH 

5 

COMH 

6 

COMH 

7 

COMH 

8 

COMH 

9 

COMH 

10 

COMH 

11 

COMH 

12 

COMH 

13 

COMH 

14 

COMH 

15 

COMH 

16 

COMH 

17 

COMH 

18 

19 

20 

PHOLE 

9 

PHOLE 

10 

PHOLE 

11 

PHOLE 

12 

PHOLE 

13 

PHOLE 

14 

PHOLE 

15 

PHOLE 

1 6 

PHOLE 

17 

PHOLE 

18 

PHOLE 

19 

PHOLE 

20 

PHOLE 

21 

PHOLE 

22 

PHOLE 

23 

-VARIABLE  MAP--(LO=A) 

-NAME ADDRESS --BLOCK PROPERTIES TYPE SIZE 


C 

174B 

HERR 

IB 

/HOLEN/ 

HOLE 

OB 

/HOLEC/ 

HTOT 

OB 

/HOLEN/ 

R 

173B 

INTEGER 

INTEGER 

CHAR*3  140 

INTEGER 

INTEGER 


-SYMBOLIC  CONSTANTS--(LO=A) 


-NAME TYPE VALUE 

HMAX  INTEGER  35 
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-STATEMENT  LABELS-- ( LO=A ) 

-LAB  EL -ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  38 

1000  124B  FORMAT  40 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS 

PHOLE  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


201B  = 129 

54B  = 44 

ilOOOB  = 25088 

0.062  SECONDS 
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1 SUBROUTINE  PROOM  PROOM 

2 » C C C C [[[  C C [[[ C C C C C C [[[ C [ C [[ C C t [ C C C [[ C C [[ C C [[[[[[[[[[ C C C C [[[ C [ C C [ C [[[ t C [ [ PROOM 

3 »[[[  [[[PROOM 

4 »[[[  PRINTOUT  THE  CONTENTS  OF  THE  ROOM  MATRIX  [[[PROOM 

5 *[[[  [[[PROOM 

6 *[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [PROOM 

7 * <t  »*«***«**«**  It  ****  1 
g It  *«**  It  **«*«**«  <r  **  I 

9 *«*  COMMON  FOR  INITIAL  PARAMETERS  ***COMF 

10  * It  * * * * * It  It  It  * It  It  It  It  It  * It  ii  It  1 

1 1 
1 2 

13 

14 

15 
1 i 

17 

18 


QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR, 


INTEGER  RMAX 
PARAMETER  (RMAX  = 20) 

COMMON  /ROOMN/  ROOM(RMAX  + 4,  RMAX  +6),  NROOMS,  RAREA(RMAX) 
INTEGER  NROOMS 
REAL  ROOM 


INTEGER  FMAX 
PARAMETER  (FMAX  = 50) 

COMMON  /INITILN/  FREQ 
$ FTOT 

COMMON  /INITILC/  BLDG 
CHARACTER  * 5 BLDG 
REAL  FREQ,  AFLAC,  RFLAG,  FREQA 
INTEGER  QUALITY,  FERR,  FTOT 

19  itiiiiit)t«iittiiitititititit 

20 

21  **  *t*t* 

22  ***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 


COMF 

COMF 

COMF 

COMF 

COMF 

COMF 

COMF 

COMF 


***COMR 

COMR 
COMR 
COMR 
COMR 
COMR 


' PROOM 

INTEGER  R,C  PROOM 

i PROOM 

PRINT*  PROOM 

PRINT*,'  ATTENUATION  (DB)  BETWEEN  ROOMS'  PROOM 

PRINT*,'  AT  FREQUENCY  = ',FREQ,'  HERTZ'  PROOM 

$*  Hit  * It  It  * It  It  It  It  It  It  ' PROOM 

DO  10  R = 1, NROOMS  PROOM 

PRINT  1000, (ROOM(R,C) , C = 1,  NROOMS  + 6)  PROOM 

10  CONTINUE  PROOM 

DO  20  R = NROOMS  + 1 , NROOMS  + 6 PROOM 

PRINT  1000,  (ROOM(R,C),  C = 1,  NROOMS  ) PROOM 

20  CONTINUE  PROOM 

PRINT* , ' ==========================================================PROOM 

$============='  PROOM 

1000  FORMAT! IX , 12 (F8 . 3)  ) PROOM 

RETURN  PROOM 

END  PROOM 


1 

2 

3 

4 

5 

6 
7 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
10 
11 
12 
13 
1 4 
15 
1 6 
17 
1 8 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 


VARIABLE 

MAP-- 

(LO=A) 

NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

AFLAC 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

C 

210B 

INTEGER 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

FTOT 

67B 

/ INITILN/ 

INTEGER 

NROOMS 

1 244B 

/ROOMN/ 

INTEGER 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

207B 

INTEGER 

SIZE 


50 
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RAREA 

1 2 4 5E 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

-SYMBOLIC  CONSTANTS-- (LO=A> 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

RMAX  INTEGER  20 


-STATEMENT  LABELS-- ( LO=A ) 

-LAB  EL- ADDRESS PROPERTIES DEF 


10  INACTIVE  DO-TERM 

20  INACTIVE  DO-TERM 

1000  154B  FORMAT 


41 

44 

47 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS 

PROOM  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


217B  = 143 

1362B  = 754 

61000B  = 25088 

0.080  SECONDS 
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1 SUBROUTINE  PTDB  PTDB 

2 **i««****«********«*«iti**************************)t**it********************PTDB 

3 » PRINT  SUMMARY  OF  THE  ATTENUATION  OF  THE  DOORS  AND  WINDOWS  PTDB 

4 ***********tt*iitt**t**tt*t****iit***tt****ii**tiitt*t**ii*ittt*tttti(***ttt*t*  PTDB 

5 *(<>**ii*******«**«*«*«***««***<i***************itit*********)r**)t*««********«c OMT 

6 »•»  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  ***COMT 


7 * COMT 

8 INTEGER  TMAX  COMT 

9 PARAMETER  (TMAX=35)  COMT 

10  COMMON  /TYPEN/TDIM(TMAX, 4) ,TTOT,TDB2(TMAX, 2) ,TDBTOT,TERR  COMT 

11  COMMON  /TYPEC/TYPE(TMAX , 3) ,TDB1 (TMAX)  COMT 

12  INTEGER  TTOT , TDBTOT , TERR  COMT 

13  REAL  TDIM,TDB2  COMT 

14  CHARACTER  * 3 TYPE.TDBl  COMT 

15  •=================================================  COMT 

U * DESCRIPTION  OF  ARRAYS  COMT 

17  *=================================================  COMT 

18  » ID  MATERIAL  FRAME  MATERIAL  COMT 

19  * COMT 

20  »TYPE(X,1)  TYPE(X,2)  TYPE(X,3)  COMT 

21  » A3  A3  A3  COMT 

22  »=================================================  COMT 

23  * HEIGHT  WIDTH  LAYER  DISTANCE  COMT 

24  » THICKNESS  ABOVE  FLOOR  COMT 

25  * COMT 

26  * TDIM(X,1)  TDIM(X,2)  TDIM(X,3)  TDIM(X,4)  COMT 

27  * F8.2  F8.2  F8 . 2 F8 . 2 COMT 

28  *=================================================  COMT 

29  * ID  ATTENUATION  AREA  COMT 

30  » COMT 

31  * TDBl(X)  TDB2(X,1)  TDB2(X,2)  COMT 

32  * A3  E9.3  E9 . 3 COMT 

33  tii*t*t*t**t*t*tt*t*tt*tiitt***ttt**tt***t**ttt****t*t**ttitt*tttt*t*ttt**tQ  OMT 

34  *tt***tt**t***t***t*t**ii***ttt***t*************t*t***tt*t*t**ttt*tt«tit**  COMT 

35  INTEGER  R,C  PTDB 

36  CHARACTER  * 3 ID  PTDB 

37  PRINT  * PTDB 

38  PRINT*, 'DOOR  AND  WINDOW  SUMMARY'  PTDB 

39  PRINT* ,'********************************* ' PTDB 

40  PRINT*, 'ID  ATTENUATION  AREA'  PTDB 

41  PRINT* ,'================================= ' PTDB 

42  DO  10  R = 1 , TDBTOT  PTDB 

43  PRINT  1000,TDB1(R) ,(TDB2(R,C) ,C=1,2)  PTDB 

44  10  CONTINUE  PTDB 

45  PRINT* ,'================================= ' PTDB 

46  1000  FORMAT  ( 1 X , A3 , 5X , F8 . 2 , 5X , F6 . 2 ) PTDB 

47  RETURN  PTDB 

48  END  PTDB 


1 

2 

3 

4 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 
6 

7 

8 
9 

10 

11 

12 

13 

14 

15 
1 6 
17 
1 8 
19 


-VARIABLE 

MAP-- 

(LO=A) 

-NAME ADDRESS 

--BLOCK 

--PROPERTIES 

---  TYPE 

---SIZE 

C 

144B 

INTEGER 

ID 

NONE 

UNUSED/ *S* 

CHAR* 3 

R 

143B 

INTEGER 

TDBTOT 

32  3B 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

1 40 

TERR 

324B 

/TYPEN/ 

INTEGER 

TTOT 

214B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

105 
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-SYMBOLIC  COKSTANTS--(LO=A) 


-NAME TYPE VALUE 

"MAS  INTEGER  35 


-STATEMENT  LABELS-- { LO=A) 

-LAE  EL- ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  44 

1000  107B  FORMAT  46 


-ENTRY  ?OINTS--(LO=A) 
-NAME ADDRESS --ARGS 

PTDB  53  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


151B  = 105 

3773  = 255 

61000E  = 25088 

0.060  SECONDS 


254 


TTN  ; ;.5!: 
SUBROUTINE  PTYPE 


•4/03/14  13 . la . 23  PAGE 

74/175  OPT=0 


a 


1 SUBROUTINE  PTYPE  PTYPI 

2 • c c c c c c c c c c c c c [ c c c [ c c c c c c I c c c c c [ c [ EC c c c c r [ c c [ c E c c c c [ E c c c c [ [ m c [ c c : ' : : : : ? T Y ? I 

3 *ccc  :::?TY?z 

4 'ICI  PRINT  OUT  THE  CONTENTS  OP  THE  “TYPE"  ANE  “T3IN'*  ARRAYS  CCIPTYPE 

5 *CCC  CIIPTYPE 

i •CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCECCCCIC-’CIEPTYPE 

; ttttlltttttttlttXtXXXItXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXlX  £2 VT 

9 •••  COftMON  FOR  DATABASE  OF  TYPES  OF  DOORS  A>iL  VIN3DV5  **»:CNT 

<2  ttxItltXtttXXttltXtXItXXXtlXXXXXXXXXXXXXXXXXXtXXXlXXXXXXXXXXXXXXXIXXXXXI zzyci 


11 
1 2 
13 
1 4 
15 
1 6 

17 

18 

19 

20 
21 
22 

23 

24 

25 
28 

27 

28 

29 

30 

31 

32 

33 

34 

35 
38 

37 

38 

39 

40 

41 

42 

43 

44 

45 

48 
47 
43 

49 

50 

51 

52 

53 


INTEGER  TWA2 
PARAMETER  TMAI=35) 

COMMON  /TYPEK/TDIfUTMAX  , 4^  ,TT0T,TCB2  (TMAX  , 2 ) .TESTOT , TERR 
COMMON  /TYPEC/TYPE/TMA2.3) ,TE2I (TMA2) 

INTEGER  TTOT.TDBTOT.TERR 
REAL  TDIM.TDB2 


CHARAC 

TER  » 3 TYPE 

,TD31 

DESCRIPTION  OF  ARRAYS 

ID 

MATERIAL 

FRAME  MATERIAL 

TYPE(X, 1) 
A3 

TYPE( X.  2) 
A3 

TYFEd,  3) 
A3 

HEIGHT 

WIDTH 

LAYER 

THICKNESS 

DISTANCE 
ABOVE  FLOOR 

TDIM( I, 1) 
F8  . 2 

TDIK(X,2) 
P8  .2 

TDIMd,  3) 

pa  .2 

TDIfUl,  4; 
F8  .2 

ID 

ATTENUATION 

AREA 

TD31 (X) 
A3 

TD32(X, 1) 
E9  . 3 

TD32 (X  ,2) 
E9  . 3 

CCMT 

- n V— 


<■  " W~ 


r ^ V” 

CCMT 


CCMT 

CCMT 

- ^ V— 

'TV” 


XXttXIXXXXXXXXXXXXXXXXXXXXXXXXXI 


tXtXXXXXXtXXXXXXXXIXITXtX' 


XttXXXtIXXXXXXXXXXIXXXX] 


ixxxxxxxxxxxxxxixxxxt' 


INTEGER  R,  C 


PRINT  * 
PRINT  * 
PRINT  ‘ 
PRINT  * 
PRINT  * 
PRINT  * 
BO  10  S 


DOOR  AND  VINDOV  PARAMETERS* 

'XXXX  XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXIXfXXXtX 

ID  MATERIAL  FRAME  HEIGHT  VIDTK  LAYER  DISTANCE 


MATERIAL 


THICKNESS  ABOVE  FLR 


= l.TTOT 


PRINT  1000 , (TYPECR.C) ,C=1 , 3 ) . (TDIM(R.C) ,C=1 .4) 
10  CONTINUE 


PRINT  *,*============================ 

1 00  0 FORMAT  ( 2 1 , A3 . 4X  , A3 . 8 X , A3 . 4 1 1 2 , F7  . 2 ) ) 
RETURN 
END 


--VARIABLE  MAP--(LO=A) 

-NAME---ADDRESS--BLOCX PROPERTIES TYPE SIZE 


C 

2173 

INTEGER 

R 

218B 

INTEGER 

TDBTOT 

3233 

/TYFEN/ 

INTEGER 

TDBl 

373 

/TYPEC/ 

CHAR*3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

7 ; 

TDIM 

OB 

/TYPEN/ 

REAL 

1 4 0 

255 
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PTYPE 

74/175  OPT=0 

TERR 

32  4B 

/TYPEN/ 

INTEGER 

TTOT 

214B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

-SYMBOLIC  CONSTANTS--! LO=A) 


-NAME TYPE VALUE 

TMAX  INTEGER  35 


-STATEMENT  LABE LS- - ( LO= A ) 

-LAB  EL -ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  49 

1000  152B  FORMAT  51 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS- -- 

PTYPE  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


225B  = 149 

377B  = 255 

61000B  = 25088 

0.069  SECONDS 


256 
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1 SUBROUTINE  PWALL 

2 t************************************************* 

3 **»  PRINT  OUT  THE  CONTENTS  OF  THE  WALL  AND  WDIM  ARRAYS 

4 ******t*****************K**«*«***«******«Mt******«* 

5 » 

^ t******************************************************************* 

7 •*«  COMMON  FOR  DATABASE  OF  WALL  PARAMETERS 

g ttKtttut****************************************************************  COMV 
INTEGER  WMAX 
PARAMETER  (WMAX  = 75) 

COMMON  /WALLN/  WD IM( WMAX , 3 ) , WTOT,  WERR 
COMMON  /WALLC/  WALL(WMAX,4) 

INTEGER  WTOT, WERR 
REAL  WDIM 
CHARACTER  *3  WALL 


9 

1 0 
1 1 
1 2 
13 
1 4 
15 
U 

17 

18 

19 

20 
21 
22 

23 

24 

25 
28 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 


» DESCRIPTION  OF  ARRAYS 


WALL  IDENTIFICATION 


DIRECTION 

FROM 

ROOM 

TO 

ROOM 

WALL (X  , 1 ) 
A3 

WALL (X  , 2) 

A3 

WALL (X, 3) 
A3 

WALL  PARAMETERS 

MATERIAL 

HEIGHT 

WIDTH 

LAYER  THICKNESS 

WALLC  X, 4) 

WDIMC  X,  1) 

WDIMC  X, 2) 

WDIMC  X, 3) 

A3 

F8  . 2 

F8  . 2 

F8  . 2 

WALL  PARAMETERS’ 


INTEGER  R,  C 

r 

PRINT* 

PRINT  *,‘WALL  IDENTIFICATION 
P R I NT  *,  '********************  ****t**it****«**«i****<i**ii 
PRINT  *,’  DIR  FROM  TO  MATERIAL  HEIGHT  WIDTH 

PRINT  *, ‘ ====================  ======================== 

DO  10  R = l.WTOT 

PRINT  1000, (WALL(R,C) , C= 1 , 4 ) , ( WD IM (R , C) , C= 1 , 3 ) 

10  CONTINUE 

PRINT  *, ■============================================= 

1 000  FORMAT  ( 1 X , 3 ( 2X , A3 ) , 1 0 X , A3 , 1 X , 3 ( 1 X , F7  . 2 ) ) 

RETURN 

END 


PWALL 

1 

PWALL 

2 

PWALL 

3 

PWALL 

4 

PWALL 

5 

>COMW 

1 

*COMW 

2 

'COMW 

3 

COMW 

4 

COMW 

5 

COMW 

6 

COMW 

7 

COMW 

8 

COMW 

9 

COMW 

1 0 

COMW 

11 

COMW 

12 

COMW 

13 

COMW 

1 4 

COMW 

15 

COMW 

16 

COMW 

17 

COMW 

18 

COMW 

19 

COMW 

20 

COMW 

21 

COMW 

22 

COMW 

23 

COMW 

24 

COMW 

25 

COMW 

26 

COMW 

27 

'COMW 

28 

COMW 

29 

PWALL 

7 

PWALL 

8 

PWALL 

9 

PWALL 

10 

PWALL 

1 1 

PWALL 

12 

PWALL 

13 

PWALL 

14 

PWALL 

15 

PWALL 

16 

PWALL 

17 

PWALL 

18 

PWALL 

19 

PWALL 

20 

PWALL 

2 1 

--VARIABLE  MAP--(LO=A) 

-NAME---ADDRESS--BLOCK PROPERTIES TYPE SIZE 


C 

205B 

INTEGER 

R 

204B 

INTEGER 

WALL 

OB 

/WALLC/ 

CHAR»3 

300 

WDIM 

OB 

/WALLN/ 

REAL 

225 

WERR 

342B 

/WALLN/ 

INTEGER 

WTOT 

341B 

/WALLN/ 

INTEGER 

257 
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-SYMBOLIC  CONSTANTS--!  LO:::A) 
-NAME TYPE 

WMAX  INTEGER 


-STATEMENT  L ABE LS- - ( LO= A ) 

-LAB  EL- ADDRESS PROPERTIES DEE 

10  INACTIVE  DO-TERM  45 

1000  142B  FORMAT  47 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS--ARGS 

PWALL  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH  213B 
CM  LABELLED  COMMON  LENGTH  475B 
CM  STORAGE  USED  61000B 
COMPILE  TIME  0.063 


VALUE 

75 


= 139 

= 3 17 

= 25088 

SECONDS 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 
1 6 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


REAL  FUNCTION  RCOEF  (MATID , FREQ , RFLAG ) RCOEF 
•[[[ CC [[ CC [[[[ C CCI [[[[ t [[ CC [[[[[[[[[[ [[[[[[[[[[[[[[[[[[[CCCICt [[[[[[[[ [[RCOEF 
»[[[  [[[RCOEF 
•[[[  GIVEN  THE  MATERIAL  AND  THE  FREQUENCY,  THIS  FUNCTION  RETURNS  [[[RCOEF 
*[[[  THE  REFLECTION  COEFFICIENT  [[[RCOEF 
•[[[  [[[RCOEF 
*[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [[RCOEF 


* FREQ  IS  IN  HERTZ  RCOEF 
» HIFREQ.LOFREQ,  AND  F ARE  IN  LOG  ( HERTZ  ) RCOEF 
» RFLAG  RANGES  FROM  0 TO  100  AND  DETERMINES  HOW  MUCH  OF  THE  QUALITY  RCOEF 
» FACTOR  IS  APPLIED  TO  THE  REFLECTION  COEFFICIENT  VALUE.  RCOEF 


*»*  COMMON  FOR  DATABASE  OF  MATERIAL  PROPERTIES 


*»»COMM 


INTEGER  MMAX 
PARAMETER  (MMAX=100) 

COMMON  /MATN/  MATTEN(MMAX , 7 ) , MRCOEF (MMAX , 7 ) , 
5 MFREQ(MMAX,7) , MERR,  MTOT 

COMMON  /MATC/ MAT (MMAX) .MATDESC (MMAX ) 

INTEGER  MTOT,  MERR 

REAL  MATTEN,  MRCOEF,  MFREQ,  QA , QR 

CHARACTER  * 3 MAT 

CHARACTER  * 70  MATDESC 


COMM 

COMM 

QA(MMAX),  QR(MMAX),  COMM 
COMM 
COMM 
COMM 
COMM 
COMM 
COMM 


«*«****! 


lililitt*itii»***t**t**tt***lili'kt**tiitli*tt*t***t*ii**t*tt  RCOEF 

* DECLARATION  OF  VARIABLES  RCOEF 

t*t******t*tt*iit*ii*ii**iit**it*t*t***ttmi*iit**t*t****  RCOEF 

REAL  FREQ, FRAC , MI NFREQ,MAXFREQ,LOFREQ, HI  FREQ, LORCOEF , HI RCOEF ,F  RCOEF 
INTEGER  R,C ,RINDEX ,CINDEX  RCOEF 

LOGICAL  FOUND, EXACT  RCOEF 

CHARACTER  *3  MATID  RCOEF 

ttr*****lt****A«A**k***************«****lklk*ft***t**)k*  RCOEF 

* FIND  ROW  INDEX  OF  MATERIAL  RCOEF 

t*tt**t*t**iitii*t***iit*t**t*t*t**tt**t*ttii*****t***  RCOEF 

FOUND  = .FALSE.  RCOEF 

DO  10  R = 1,  MMAX  RCOEF 

IF  ( MAT(R)  EQ.  MATID  ) THEN  RCOEF 

FOUND  = .TRUE.  RCOEF 

RINDEX  = R RCOEF 

END  IF  RCOEF 

10  CONTINUE  RCOEF 

IF  ( .NOT.  POUND  ) THEN  RCOEF 

lERR  = 3 RCOEF 

CALL  ERROR  (lERR)  RCOEF 

END  IF  RCOEF 

tt*tiit*ttint*tt****t*tt*ii*ttt*t*ii***t**itiit***t*ttiit  RCOEF 

* TEST  FOR  FREQUENCY  OUT  OF  RANGE  RCOEF 

t***ttlitt***t*t*tt*tt***li*litli*lrk*li**ltitttttt*t**ttli  RCOEF 

MINFREQ  = MFREQ  (RINDEX,!)  RCOEF 

MAXFREQ  = MFREQ  (RINDEX, 7)  RCOEF 

IF  ( FREQ  .LT.  MINFREQ  .OR.  FREQ  .GT.  MAXFREQ  ) THEN  RCOEF 

lERR  = 2 RCOEF 

CALL  ERROR  (lERR)  RCOEF 

END  IF  RCOEF 

**************************************************  RCOEF 

* IF  THE  EXACT  FREQUENCY  IS  IN  THE  TABLE,  THEN  RCOEF 

» USE  THE  REFLECTION  COEFFICIENT  VALUE  WITHOUT  INTERPOLATION.  RCOEF 

t****t***************»i************t*********«*****  RCOEF 

DO  20  C=  1,7  RCOEF 

EXACT  = .FALSE.  RCOEF 

IF  ( FREQ  .EQ.  MFREQ  (RINDEX, C)  ) THEN  RCOEF 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 

I 3 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 

I I 
12 

13 

14 

15 

16 
17 
1 8 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 
4 4 

45 

46 

47 

48 

49 

50 

51 
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65 

EXACT  = .TRUE. 

RCOEF 

52 

66 

CINDEX  = C 

RCOEF 

53 

67 

RCOEF  = MRCOEF  (RINDEX , CINDEX ) 

RCOEF 

54 

68 

RCOEF  = RCOEF  * ( 1 + 

RFLAG  / 100  ) 

RCOEF 

55 

69 

END  IF 

RCOEF 

56 

70 

20 

CONTINUE 

RCOEF 

57 

71 

RCOEF 

58 

72 

* 

INTERPOLATE  REFLECTION  COEFFICIENT  VALUES  IF  EXACT  FREQUENCY  IS 

RCOEF 

59 

73 

* 

NOT  IN  THE  FREQUENCY/REFLECTION  COEFFICIENT  ARRAYS. 

RCOEF 

60 

74 

**i(iiiiiiiiiiiiiiii*iit*****it***tt***ii**t**it**itt**iit*ti(ttiit 

RCOEF 

61 

75 

IF  ( NOT.  EXACT  ) THEN 

RCOEF 

62 

76 

DO  30  C=l,6 

RCOEF 

63 

77 

IF  ( FREQ  .GT.  MFREQ 

(RINDEX, C)  .AND. 

RCOEF 

64 

78 

5 FREQ  LT.  MFREQ 

(RINDEX, C+1)  ) THEN 

RCOEF 

65 

79 

CINDEX  = C 

RCOEF 

66 

80 

END  IF 

RCOEF 

67 

81 

30 

CONTINUE 

RCOEF 

68 

82 

F = ALOGIO  ( FREQ  ) 

RCOEF 

69 

83 

LOFREQ  = ALOGIO  ( MFREQ 

(RINDEX,  CINDEX)  ) 

RCOEF 

70 

84 

HIFREQ  = ALOGIO  ( MFREQ 

(RINDEX,  CINDEX  + 1)  ) 

RCOEF 

71 

85 

LORCOEF  = MRCOEF  (RINDEX 

, CINDEX) 

RCOEF 

72 

86 

HIRCOEF  = MRCOEF  (RINDEX 

, CINDEX  + 1) 

RCOEF 

73 

87 

FRAC  = (F  - LOFREQ)  / (HIFREQ  - LOFREQ) 

RCOEF 

74 

88 

RCOEF  = LORCOEF  + (FRAC 

* (HIRCOEF  - LORCOEF)  ) 

RCOEF 

75 

89 

RCOEF  = RCOEF  * ( 1 + RFLAG  / 100  ) 

RCOEF 

76 

90 

END  IF 

RCOEF 

77 

91 

RETURN 

RCOEF 

78 

92 

END 

RCOEF 

79 

VARIABLE 

MAP-- 

(LO=A) 

NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

- -SIZE 

C 

254B 

INTEGER 

CINDEX 

256B 

INTEGER 

EXACT 

260B 

LOGICAL 

F 

25  2B 

REAL 

FOUND 

257B 

LOGICAL 

FRAC 

243B 

REAL 

FREQ 

2 

DUMMY-ARG 

REAL 

HIFREQ 

247B 

REAL 

HIRCOEF 

25  IB 

REAL 

lERR 

26  2B 

INTEGER 

LOFREQ 

2 4 6B 

REAL 

LORCOEF 

250B 

REAL 

MAT 

OB 

/MATC/ 

CHAR*3 

1 00 

MATDESC 

36B 

/MATC/ 

CHAR* 70 

100 

MAT  ID 

1 

DUMMY-ARG 

CHAR*3 

MATTEN 

OB 

/MATN/ 

REAL 

700 

MAXFREQ 

2 4 5B 

REAL 

MERR 

4374B 

/MATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

7 00 

MINFREQ 

2 4 4B 

REAL 

MRCOEF 

1 2 7 4B 

/MATN/ 

REAL 

700 

MTOT 

4375B 

/MATN/ 

INTEGER 

QA 

257  0B 

/MATN/ 

REAL 

1 00 

QR 

2 7 34B 

/MATN/ 

REAL 

100 

R 

253B 

INTEGER 

RCOEF 

242B 

REAL 

RFLAG 

3 

DUMMY-ARG 

REAL 

RINDEX 

255B 

INTEGER 

260 
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FTN  5 1+552 

FUNCTION  RCOEF 


-SYMBOLIC  CONSTANTS--( LO=A) 


-NAME TYPE VALUE 

MMAX  INTEGER  100 


-PROCEDURES 

--(LO=A) 

-NAME 

TYPE 

--ARGS--- 

---CLASS 

ALOGIO 

REAL 

1 

INTRINSIC 

ERROR 

1 

SUBROUTINE 

-STATEMENT  LABELS-- ( LO=A ) 


LABEL- 

ADDRESS--- 

--PROPERTIES- 

---DEF 

10 

INACTIVE 

DO-TERM 

44 

20 

INACTIVE 

DO-TERM 

70 

30 

INACTIVE 

DO-TERM 

81 

ENTRY 

POINTS--(LO=A) 

NAME-- 

-ADDRESS-- 

ARGS 

RCOEF 

6B 

3 

-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

287B 

= 183 

CM  LABELLED  COMMON  LENGTH 

5730B 

= 3032 

CM  STORAGE  USED 

81000B 

= 25088 

COMPILE  TIME 

0.127 

SECONDS 

261 
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1 SUBROUTINE  SRCHTDB  (ID,  OATTEN , OAREA ) SRCHTDB 

2 * [ It  t C C C [ [ [ I C C [ C [ C C [ [ [ t [ [ t C C [ [ [ C t [ [ C C C C U t C C t [ C [ C [ [ [ C [ [ C C C [ I C C t C [ [ [ C [ [ C [ SRCHTDB 

3 *111  [[[SRCHTDB 

4 *[[[  GIVEN  AN  OPENING  ID,  THIS  SUBROUTINE  RETURNS  ITS  ATTENUATION  [[[SRCHTDB 

5 *[[[  AND  AREA.  [[[SRCHTDB 

6 *[[[  [[[SRCHTDB 

7 *[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[ [ [SRCHTDB 

g * It  * t 1 1 1 1 1 1 1 -k  t 1 1 It  * 1 1 * It  t 1 1 1 1 1 1 1 it  It  1 1 1 1 1 1 1 1 1 1 1 1 1 h 1 1 It  t * 1 1 * t It  1 1 1 It  It  tt  1 1 1 1 1 1 1 1 1 QQ 

9 ***  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  ***COMT 

IQ  *A***A*****!li(t***!ll[A*A:k**A*1l(*ft1i*t**Alicf(*t*A*AA*Alt**At*t*k*A**A**t*fttfMk*f(*At  COMT 

11  INTEGER  TMAX  COMT 

12  PARAMETER  (TMAX=35)  COMT 

13  COMMON  /TYPEN/TDIM(TMAX,4> ,TTOT,TDB2(TMAX,2) ,TDBTOT,TERR  COMT 

14  COMMON  /TYPEC/TYPE(TMAX,3) ,TDB1(TMAX)  COMT 

15  INTEGER  TTOT , TDBTOT , TERR  COMT 

16  REAL  TDIM,TDB2  COMT 

17  CHARACTER  * 3 TYPE,TDB1  COMT 

18  »=================================================  COMT 

19  * DESCRIPTION  OF  ARRAYS  COMT 

20  *=================================================  COMT 

21  * ID  MATERIAL  FRAME  MATERIAL  COMT 

22  * COMT 

23  *TYPE(X,1)  TYPE(X,2)  TYPE(X,3)  COMT 

24  * A3  A3  A3  COMT 

25  *=================================================  COMT 

26  * HEIGHT  WIDTH  LAYER  DISTANCE  COMT 

27  « THICKNESS  ABOVE  FLOOR  COMT 

28  * COMT 

29  * TDIM(X,1)  TDIM(X,2)  TDIM(X,3)  TDIM(X,4)  COMT 

30  * F8  . 2 F8  . 2 F8  . 2 F8  . 2 COMT 

31  *=================================================  COMT 

32  * ID  ATTENUATION  AREA  COMT 

33  * COMT 

34  * TDBKX)  TDB2(X,1)  TDB2(X,2)  COMT 

35  » A3  E9.3  E9.3  COMT 

38  »*******»***»***»**************»*****»********»»*****»*********i«*»*****»C0  MT 


37  * COMT 


38 

INTEGER  R 

SRCHTDB 

39 

REAL  OAREA, OATTEN 

SRCHTDB 

40 

CHARACTER  *3  ID 

SRCHTDB 

41  * 

SRCHTDB 

42 

DO  10  R = 1 , TDBTOT 

SRCHTDB 

43 

IF  (TDBl(R)  .EQ.  ID)  THEN 

SRCHTDB 

44 

OATTEN  = TDB2(R,1) 

SRCHTDB 

45 

OAREA  = TDB2(R,2) 

SRCHTDB 

46 

RETURN 

SRCHTDB 

47 

END  IF 

SRCHTDB 

48 

10  CONTINUE 

SRCHTDB 

49 

END 

SRCHTDB 

VARIABLE 

MAP-- 

(LO=A) 

NAME ADDRESS 

--BLOCK--  - PROPERTIES 

--  -TYPE 

SIZE 

ID 

1 

DUMMY-ARG 

CHAR«3 

OAREA 

3 

DUMMY-ARG 

REAL 

OATTEN 

2 

DUMMY-ARG 

REAL 

R 

65B 

INTEGER 

TDBTOT 

32  3B 

/TYPEN/ 

INTEGER 

TDBl 

37E 

/TYPEC/ 

CHAR*3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

140 

TERR 

32  4B 

/TYPEN/ 

INTEGER 

TTOT 

21  4B 

/TYPEN/ 

INTEGER 

1 

2 

3 

4 

5 

6 

7 

1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

22 

23 

24 

25 

26 

27 

28 

29 

30 

9 

1 0 

11 

12 

13 

14 

15 

1 6 

17 

1 8 

19 

20 
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TYPE  OB  /TYPEC/ 

-SYMBOLIC  CONSTANTS--(LO=A) 


-NAME TYPE -VALUE 

TMAX  INTEGER  35 


-STATEMENT  LABELS- -( LO= A ) 

-LAB  EL -ADDRESS PROPERTIES DEE 

10  INACTIVE  DO-TERM  48 


-ENTRY  POINTS--(LO=A) 
-NAME--- ADDRESS- -ARCS- -- 

SRCHTDB  5B  3 


-STATISTICS-- 

PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


71B  = 57 

377B  = 255 

81000B  = 250 

0.049  SECONDS 


CHAR*3  105 
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SUBROUTINE  UARNING(ERR) 


WARNING 


2 

INTEGER  ERR, 

ERRM 

WARNING 

2 

3 

CHARACTER*45 

MESSAGE!20) 

WARNING 

3 

4 

DATA 

MESSAGE! 

1 

)/"'HOLE"  DATA  F 

ILE  DOES  NOT  EXIST  FOR  THIS 

BLDG  ' 

/ 

WARNING 

4 

5 

DATA 

MESSAGE ! 

2 

) / 'FILE  HANDLING 

PROBLEM  ON  "HOLE"  DATA  FILE 

' 

/ 

WARNING 

5 

6 

DATA 

MESSAGE! 

3 

//'"MATTER"  FILE 

DOES  NOT  EXIST  FOR  THIS  BLDG 

/ 

WARNING 

6 

7 

DATA 

MESSAGE ! 

4 

> / ' FILE  HANDLING 

PROBLEM  ON  "MATTER  FILE 

' 

/ 

WARNING 

7 

8 

DATA 

MESSAGE! 

5 

//■"TYPE"  DATA  F 

ILE  DOES  NOT  EXIST  FOR  THIS 

BLDG  ' 

/ 

WARNING 

8 

9 

DATA 

MESSAGE ! 

6 

) / ' FILE  HANDLING 

PROBLEM  ON  "TYPE"  FILE 

' 

/ 

WARNING 

9 

1 0 

DATA 

MESSAGE ! 

7 

//'"WALL"  DATA  F 

ILE  DOES  NOT  EXIST  FOR  THIS 

BLDG  ' 

/ 

WARNING 

10 

11 

DATA 

MESSAGE ! 

8 

) / ' FILE  HANDLING 

PROBLEM  ON  "WALL"  FILE 

' 

/ 

WARNING 

1 1 

1 2 

DATA 

MESSAGE! 

9 

) / 'HEIGHT  AND  WI 

DTH  OF  ROOM  MISSING 

■ 

/ 

WARNING 

12 

13 

DATA 

MESSAGE! 

10 

//'LENGTH  OF  ROOM  IS  MISSING 

' 

/ 

WARNING 

13 

1 4 

DATA 

MESSAGE ! 

11 

//'FREQ  FILE  DOES  NOT  EXIST  FOR  THIS  BLDG 

• 

/ 

WARNING 

14 

15 

DATA 

MESSAGE ! 

12 

/ / ' FILE  HANDLING 

PROBLEM  WITH  FREQ  FILE 

' 

/ 

WARNING 

15 

1 6 

DATA 

MESSAGE! 

13 

//'WARNING  CODE 

IS  OUT  OF  RANGE 

' 

/ 

WARNING 

16 

17 

DATA 

MESSAGE ! 

14 

/ / 'WARNING  CODE 

IS  OUT  OF  RANGE 

' 

/ 

WARNING 

17 

1 8 

DATA 

MESSAGE! 

15 

//'WARNING  CODE 

IS  OUT  OF  RANGE 

' 

/ 

WARNING 

18 

19 

DATA 

MESSAGE! 

16 

/ / 'WARNING  CODE 

IS  OUT  OF  RANGE 

' 

/ 

WARNING 

19 

20 

DATA 

MESSAGE! 

17 

//'WARNING  CODE 

IS  OUT  OF  RANGE 

' 

/ 

WARNING 

20 

21 

DATA 

MESSAGE ! 

18 

/ / 'WARNING  CODE 

IS  OUT  OF  RANGE 

' 

/ 

WARNING 

21 

22 

DATA 

MESSAGE! 

19 

//'WARNING  CODE 

IS  OUT  OF  RANGE 

' 

/ 

WARNING 

22 

23 

DATA 

MESSAGE ! 

20 

/ / 'WARNING  CODE 

IS  OUT  OF  RANGE 

' 

/ 

WARNING 

23 

24 

ERRM: 

= 12 

V/ARNING 

24 

25 

lERR 

= ERR 

WARNING 

25 

26  IF(ERR  GT.ERRM)  IERR=20 

27  WRITE(6,20) 

28  WRITE(6,10)  ERR , MESSAGE ( I ERR ) 

29  WRITE(6,20) 

30  10  FORMAT! • ***WARNING  NUMBER  = 

31  20  FORMAT!'  ') 

32  RETURN 

33  END 


15  , 


, A45  ) 


WARNING 

WARNING 

WARNING 

WARNING 

WARNING 

WARNING 

WARNING 

WARNING 


26 

27 

28 

29 

30 

31 

32 

33 


-VARIABLE  MAP--!LO=A) 
-NAME ---ADDRESS --BLOCK - 


-PROPERTIES TYPE SIZE 


ERR 

ERRM 

lERR 

MESSAGE 


1 DUMMY-ARG 
60B 
213B 
61B 


INTEGER 

INTEGER 

INTEGER 

CHAR*45 


20 


-STATEMENT  L ABE LS- - ! LO= A ) 

-LAB  EL- ADDRESS PROPERTIES DEF 


10  34B  FORMAT 

20  42B  FORMAT 


30 

31 


-ENTRY  POINTS--!LO=A) 
-NAME ADDRESS --ARGS 

WARNING  5B  1 
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-I/O  UNITS--(LO=A) 

-NAME PROPERTIES 

TAPE6  FMT/SEQ 


-STATISTICS-- 

PROCRAM-UNIT  LENGTH  216B 
CM  STORAGE  USED  &1000B 
COMPILE  TIME  0.061 


3 PAGE  58 


= 142 

= 25088 

SECONDS 
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59 


1 

2 

3 

4 

5 

6 
7 
B 
9 

10 

11 

12 

13 

14 

15 
U 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 


SUBROUTINE  SETUP  SETUP 

**«**<l***«l«  + ««ltA*««X«****lt«I***«lt*tt**lltt*«******1t«****«(*«*«lit*******«**«**«cC0M{l 

***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  *»»COMR 

****t**k*ittlttii*iiii*tK**tli*iili»t***l(li*li***iitl(*i(iii(iitit*iiii*********li***tfk**t*  COMR 
INTEGER  RMAX  COMR 

PARAMETER  (RMAX  = 20)  COMR 

COMMON  /ROOMN/  ROOM(RMAX  + 6,  RMAX  + 6),  NROOMS , RAREA(RMAX)  COMR 

INTEGER  NROOMS  COMR 

REAL  ROOM  COMR 

**»***»******(Mit***********»***»*»*»«**j(***«»»*****fti!i**ts«***ft**«<[»**»sr»*  COMR 

*******iiii*iiii*iiiiii*tiiiiiiini*iitii***t*****iit*ii*t**t**iiii****t*t*ii******  COMJ 

* COMJ 

* COMMON  FOR  EVALUATION  OF  ROOM  MATRIX  COMJ 

* COMJ 

COMMON  /MAT/TMAT(RMAX,RMAX) ,ENERGY(RMAX) ,POUER(6) ,FTIME  COMJ 

+,SWR(RMAX,6) , IDIR  COMJ 

REAL  TMAT  , ENERGY , POWER , SWR  COMJ 

LOGICAL  FTIME  COMJ 

* COMMON  FOR  ABSORPTION  AND  REFLECTION  COEFFICIENTS  IN  WALLS  COMD 

COMMON  /ROOMD/DDABS<RMAX  + A,  RMAX  + 6 ) ,DREFL,  DREFLV  COMD 

REAL  DDABS  .DREFL  , DREFLV  COMD 


t^************»****>k<r*************Jt********************jir***************#tcOMD 


DATA  FTIME  /.TRUE./  SETUP 

IF  (FTIME . EQV .. FALSE . ) GOTO  500  SETUP 

C***************************************************  SETUP 

C*  CALCULATE  DIAGONAL  ELEMENTS  SETUP 

C*  ASSUME  DIAGONAL  ELEMENTS  ARE  INITIALLY  ZERO  SETUP 

C*A*A  + AltA*A******AA**A*A*AA1t1k*A*A1t1lt***1k***A*****1ltA**  SETUP 

DO  200  IR=1, NROOMS  SETUP 

DIAG  =0.0  SETUP 

DO  100  IC=1, NROOMS  + 6 SETUP 

100  DIAG  =DIAG  + ROOM(IR,IC)  + DDABSdR.IC)  SETUP 

200  ROOM(IR,IR)  = -DIAG  SETUP 

Q*t*At***AA**A«**1tA****A**AtAAt**A**lkil(ik**A*AtA«*t**  SETUP 

C*  SET  FTIME  FALSE  SETUP 

C*tAAAAAAAAAAAA**AAAAAAAAAAAA*ftA*AA*AHt*A*AAA*AA*AAA  SETUP 

FTIME  = .FALSE.  SETUP 

C***)KA****A*******AAAA*****A*****AA*A*****A*A******  SETUP 

SETUP 

C*  NOW  LOAD  ROOM  INTO  TMAT  SETUP 

C»  NOTE  THAT  THE  T MATRIX  IS  REFLECTED  ABOUT  THE  DIAGONAL  SETUP 

C*  WITH  RESPECT  TO  THE  ROOM  MATRIX  SETUP 

500  DO  600  IR  = 1,  NROOMS  SETUP 

DO  600  IC  = 1,  NROOMS  SETUP 

600  TMAT(IR,IC)  = ROOM(IC,IR)  SETUP 

RETURN  SETUP 

END  * SETUP 


1 

1 

2 

3 

4 

5 

6 
7 
3 
9 

10 

1 

2 

3 

4 

5 

6 

7 

8 
9 
1 
2 

3 

4 

5 

6 
7 

5 

6 

7 

8 
9 

10 
11 
1 2 
13 
1 4 

15 

16 
17 
1 8 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 


VARIABLE 

MAP-- 

( LO=A) 

NAME---ADDRESS 

--BLOCK--- 

---PROPERTIES 

TYPE  

SIZE 

DDABS 

OB 

/ROOMD/ 

REAL 

6 76 

DIAG 

1 1 4B 

REAL 

DREFL 

1 2 4 4B 

/ROOMD/ 

REAL 

DREFLV 

1 245B 

/ROOMD/ 

REAL 

ENERGY 

6 2 0B 

/MAT/ 

REAL 

20 

FTIME 

652B 

/MAT/ 

LOGICAL 
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1C 

1 ISB 

INTEGER 

IDIR 

1 0 43B 

/MAT/ 

INTEGER 

IR 

112B 

INTEGER 

NROOMS 

1 2 4 4B 

/ROOMN/ 

INTEGER 

POUER 

644B 

/MAT/ 

REAL 

6 

RAREA 

1 24SB 

/ROOMN/ 

REAL 

20 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

SWR 

6S3B 

/MAT/ 

REAL 

1 20 

TMAT 

OB 

/MAT/ 

REAL 

400 

-SYMBOLIC  CONSTANTS--! LO=A> 


-NAME TYPE VALUE 

RMAX  INTEGER  20 


-STATEMENT  LABELS-- ( LO=A ) 


-LABEL- 

ADDRESS--- 

--PROPERTI ES 

-DEF 

100 

INACTIVE 

DO-TERM 

37 

200 

INACTIVE 

DO-TERM 

38 

500 

53B 

49 

600 

INACTIVE 

DO-TERM 

51 

-ENTRY 

POINTS--(LO=A) 

-NAME-- 

-ADDRESS-- 

ARGS 

SETUP 

5B 

0 

-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

123B 

= 83 

CM  LABELLED  COMMON  LENGTH 

360  3B 

= 1923 

CM  STORAGE  USED 

61000B 

= 25088 

COMPILE  TIME 

0.074 

SECONDS 
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UNCTION 

DETERM  74/175  OPT=0 

1 

C * * 

FUNCTION  DETERM 

DETERM 

1 

2 

C * * 

DETERM 

2 

3 

c*  * 

PURPOSE 

DETERM 

3 

4 

c * * 

CALCULATE  THE  DETERMINANT  OF  A SQUARE  MATRIX 

DETERM 

4 

5 

c*  * 

DETERM 

5 

& 

c*» 

USAGE 

DETERM 

6 

7 

c*  * 

DET=DETERM( ARRAY ,NORDER) 

DETERM 

7 

8 

c** 

DETERM 

8 

9 

c*  * 

DESCRIPTION  OF  PARAMETERS 

DETERM 

9 

10 

c** 

ARRAY  - MATRIX 

DETERM 

10 

11 

c*  * 

NORDER  - ORDER  OF  DETERMINANKDEGREE  OF  MATRIX) 

DETERM 

1 1 

12 

c * * 

DETERM 

12 

13 

c*  * 

COMMENTS 

DETERM 

1 3 

14 

c»« 

THIS  SUBROUTINE  DESTROYS  THE  INPUT  MATRIX  ARRAY 

DETERM 

14 

15 

c*  * 

THIS  ROUTINE  WAS  MODIFIED  SO  THAT  THE  MAXIMUM 

DETERM 

15 

16 

c*  * 

VALUE  IN  THE  TOP  ROW  IS  MOVED  OVER  TO  THE  DIAGONAL 

DETERM 

16 

17 

FUNCTION  DETERM( ARRAY, NORDER) 

DETERM 

1 7 

1 B 

DIMENSION  ARRAY(20,*) 

DETERM 

18 

19 

10 

DETERM=1 . 

DETERM 

1 9 

20 

1 1 

DO  50  K=1 .NORDER 

DETERM 

20 

21 

c*  * 

DETERM 

2 1 

22 

c** 

INTERCHANGE  COLUMNS  IF  DIAGONAL  ELEMENT  IS  ZERO 

DETERM 

22 

23 

c*  * 

DETERM 

23 

24 

21 

AMAX=0  0 

DETERM 

24 

25 

JMAX---K 

DETERM 

2 5 

26 

DO  25  J=K, NORDER 

DETERM 

26 

27 

TMP=ARRAY(K, J) 

DETERM 

27 

28 

TMP=ABS(TMP) 

DETERM 

28 

29 

IF(TMP.LT.AMAX)  GOTO  25 

DETERM 

29 

30 

AMAX=TMP 

DETERM 

30 

3 1 

JMAX=J 

DETERM 

3 1 

32 

25 

CONTINUE 

DETERM 

32 

33 

JrJMAX 

DETERM 

33 

34 

IF(J.GT.K)  GOTO  31 

DETERM 

34 

35 

AATMP  = AES(ARRAY(K,K)  ) 

DETERM 

35 

36 

IF  (AATMP  GE.  l.OE-05)  GOTO  41 

DETERM 

36 

37 

30 

DETERM  =0 . 

DETERM 

37 

38 

GOTO  60 

DETERM 

38 

39 

31 

DO  34  UK, NORDER 

DETERM 

39 

40 

SAVE=ARRAY (I , J) 

DETERM 

40 

41 

ARRAY! I , J) =ARRAY( I , K) 

DETERM 

41 

42 

34 

ARRAY! I ,K)=SAVE 

DETERM 

42 

43 

DETERM=-DETERM 

DETERM 

43 

44 

c** 

DETERM 

44 

45 

c*  * 

SUBTRACT  ROW  K FROM  LOWER  ROWS  TO  GET  DIAGONAL  MATRIX 

DETERM 

45 

46 

c** 

DETERM 

46 

47 

41 

DETERM:=DETERM*ARRAY  !K  , K) 

DETERM 

47 

48 

IF !DETERM . EQ  . 0 . 0)  RETURN 

DETERM 

48 

49 

IF!K-NORDER>  43,50,50 

DETERM 

49 

50 

43 

KUK+1 

DETERM 

50 

51 

DO  46  UKl  .NORDER 

DETERM 

51 

52 

DO  46  J=K1, NORDER 

DETERM 

52 

53 

46 

ARRAY! I , J)=ARRAY! I ,J) -ARRAY! I ,K) *ARRAY!K, J) /ARRAY!K,K) 

DETERM 

53 

54 

50 

CONTINUE 

DETERM 

54 

55 

60 

RETURN 

DETERM 

55 

56 

END 

DETERM 

56 
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42 

FUNCTION 

DETERM  74/175 

OPT  = 0 

-VARIABLE 

MAP-- 

(LO=A) 

-NAME ADDRESS 

--BLOCK 

PROPERTI 

ES 

-TYPE 

AATMP 

2 2 2B 

REAL 

AMAX 

215B 

REAL 

ARRAY 

1 

DUMMY-ARG 

REAL 

DETERM 

212B 

REAL 

I 

22  3B 

INTEGER 

J 

217B 

INTEGER 

UMAX 

2 1 6B 

INTEGER 

K 

21  3B 

INTEGER 

K1 

22&B 

INTEGER 

NORDER 

2 

DUMMY-ARG 

INTEGER 

SAVE 

22SB 

REAL 

TMP 

221B 

REAL 

-PROCEDURES 

--(LO=A) 

-NAME 

TYPE 

-ARCS-  - 

---CLASS 

ABS 

GENERIC 

1 

INTRINSIC 

-STATEMENT  LABELS--( LO=A) 


LABEL- 

ADDRESS 

--PROPERTIES-- 

-DEF 

-LABEL 

-ADDRESS-  -■ 

--PROPERTIES- 

---DEF 

10 

*NO 

REFS* 

19 

34 

INACTIVE 

DO-TERM 

42 

11 

*NO 

REFS* 

20 

41 

124B 

47 

21 

»NO 

REFS* 

24 

43 

INACTIVE 

50 

25 

44B 

DO-TERM 

32 

44 

INACTIVE 

DO-TERM 

53 

30 

*NO 

REFS* 

37 

50 

20  0B 

DO-TERM 

54 

31 

71B 

39 

40 

205B 

55 

-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS 

DETERM  4B  2 


-STATISTICS-- 

PROGRAM-UNIT  LENGTH  233B  = 155 

CM  STORAGE  USED  61000B  = 25088 

COMPILE  TIME  0.111  SECONDS 
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1 
2 

3 

4 

5 

6 

7 

8 
7 

1 0 
1 1 
12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

5 0 3 0 0 


SUBROUTINE  ECALC 
DIMENSION  PVECTOR(20) 
REAL  NUM 
LOGICAL  TLOW 


ECALC 

ECALC 

ECALC 

ECALC 


* * * * * It  * * * * * * **  t * * » * * * * * * * t**  * * * * t * * t * * * * * *■»  * t **  tt***  * * * * * * * t * * * * * **  t * * t * 

***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  V/ALLS  ***COMR 

* * * * * * * * * * n * * * * n 1 1 k 1 1 1 * * * t * 1 1 h * * * * * * * * H * * t * 1 1 * t * * t It  h 1 1 * * * t * t * t * * t * * t * * * t 

INTEGER  RMAX  COMR 

PARAMETER  (RMAX  = 20)  COMR 

COMMON  /ROOMN/  ROOMIRMAX  + 6,  RMAX  + 6),  NROOMS , RAREA(RMAX)  COMR 

INTEGER  NROOMS  COMR 

REAL  ROOM  COMR 

k It  k k k 1 1 * t k * It  It  It  t t it  k t k * k It  k k It  k It  * k t k k k k k k t k k k k k It  t k k k * 1 1 1 it  k k * k * k t k k * k k * k * * k k * 
k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k k 
kkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkkk 
k 

* COMMON  FOR  EVALUATION  OF  ROOM  MATRIX 

tk 

t'kKt'ktt'ktttKK'ktKt'kttKHtt'kttt'kt'klitlitimtttttmdittttttHttiittt'klildit* 

COMMON  /MAT/TMAT(RMAX,RMAX) , ENERGY ( RMAX ) ,POWER(6) ,FTIME 
+,SWR(RMAX, 6) , IDIR 
REAL  TMAT  , ENERGY , POWER , SWR 
LOGICAL  FTIME 

tliil'ktit'kt'kt'kt'kif'kidl'kat'kil'kt'ktil'ktttt'kttimiit'kttt'k'kit'k'kt'k 

* CALCULATE  THE  ENERGY  BALANCE  IN  THE  ROOMS 

* 

* CALCULATE  THE  DENOMINATOR  TERM 

CALL  SETUP 

DENOM=DETERM( TMAT, NROOMS) 

IF(DENOM)  100,50,100 

************************************************** 

* ERROR  # 4:  DENOMINATOR  = 0. 


51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


5 0 I ERR  = 4 

CALL  ERROR(IERR) 

RETURN 

************************************************** 

» CALCULATE  THE  INPUT  POWER  VECTOR  TO  EACH  ROOM 
************************************************** 
100  TLOW=.TRUE. 

DO  300  ICOL  = 1 , NROOMS 
SUM  =0.0 

DO  200  IPUR  = 1,6 
IROV  = IPWR  + NROOMS 

200  SUM  = SUM  + POWER(IPWR)  * ROOM(IROW,1 

PVECTOR( ICOL)  = - SUM 
IF  (SUM.GT. (1 . OE-06))  TLOW= . FALSE . 
************************************************** 

* CHECK  IF  INPUT  POWER  IS  TOO  LOW 

************************************************** 
IF  (TLOW. NEQV.  TRUE . ) GOTO  350 
************************************************** 

* INPUT  TOO  LOW 

************************************************** 

DO  310  ICOL=l , NROOMS 
310  ENERGY! ICOL)  = l . OE-05 
RETURN 

************************************************** 

* SET  UP  NUMERATORS 

************************************************** 

* RENEW  TMATRIX 


2 

3 

4 

5 

6 

7 

8 
9 

10 


COMJ 

1 

COMJ 

2 

COMJ 

3 

COMJ 

4 

COMJ 

5 

COMJ 

6 

COMJ 

/ 

COMJ 

8 

COMJ 

9 

ECALC 

7 

ECALC 

8 

ECALC 

9 

ECALC 

10 

ECALC 

11 

ECALC 

1 2 

ECALC 

13 

ECALC 

1 4 

ECALC 

15 

ECALC 

1 6 

ECALC 

17 

ECALC 

18 

ECALC 

19 

ECALC 

20 

ECALC 

21 

ECALC 

22 

ECALC 

23 

ECALC 

24 

ECALC 

25 

ECALC 

26 

ECALC 

27 

ECALC 

28 

ECALC 

29 

ECALC 

30 

ECALC 

31 

ECALC 

32 

ECALC 

33 

ECALC 

34 

ECALC 

35 

ECALC 

36 

ECALC 

37 

ECALC 

36 

ECALC 

39 

ECALC 

40 

ECALC 

41 

ECALC 

42 

ECALC 

43 

ECALC 

44 

ECALC 

45 

ECALC 

46 

ECALC 

47 
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65 

AAAAAAAAAAA 

ECALC 

48 

66 

350  DO  500  ICOL  = l.NROOMS 

ECALC 

49 

67 

CALL  SETUP 

ECALC 

50 

68 

* 

AAAAAAAAAAA 

ECALC 

51 

69 

t 

PUT  PVECTOR  INTO  PROPER  COLUMN 

ECALC 

52 

70 

t 

A************************************* 

AAAAAAAAAA* 

ECALC 

53 

71 

DO  400  IROW  = l.NROOMS 

ECALC 

54 

72 

400  TMAT( IROW, ICOL)  = PVECTOR 

! IROW) 

ECALC 

55 

73 

t 

AAAAAAAAAAAAAAAAAAAAAA**************** 

AAAAAAAAAAA 

ECALC 

56 

74 

t 

NOW  CALCULATE  THE  ENERGY  FOR  THE  ROOM 

REPRESENTED 

ECALC 

57 

75 

A 

BY  ICOL 

ECALC 

58 

76 

A 

AA*A*AAA*A*AAAA*A**AAA**AAA*A*AAAAAAAA 

AAAtAAAAAAA 

ECALC 

59 

77 

NUM  = DETERM(TMAT,NROOMS) 

ECALC 

60 

78 

ENERGY! ICOL)  = NUM/DENOM 

ECALC 

61 

79 

500  CONTINUE 

ECALC 

62 

80 

RETURN 

ECALC 

63 

81 

END 

ECALC 

64 

-VARIABLE  MAP--(LO=A) 


NAME 

ADDRESS- 

-BLOCK 

--PROPERTIES 

TYPE 

---SIZE 

DENOM 

213B 

REAL 

ENERGY 

620B 

/MAT/ 

REAL 

20 

FTIME 

652B 

/MAT/ 

LOGICAL 

ICOL 

215B 

INTEGER 

IDIR 

1 043B 

/MAT/ 

INTEGER 

lERR 

214B 

INTEGER 

IPWR 

220B 

INTEGER 

IROW 

222B 

INTEGER 

NROOMS 

1244B 

/ROOMN/ 

INTEGER 

NUM 

21  IB 

REAL 

POWER 

644B 

/MAT/ 

REAL 

6 

PVECTOR 

USB 

REAL 

20 

RAREA 

124SB 

/ROOMN/ 

REAL 

20 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

SUM 

217B 

REAL 

SWR 

653B 

/MAT/ 

REAL 

120 

TLOW 

212B 

LOGICAL 

TMAT 

OB 

/MAT/ 

REAL 

400 

-SYMBOLIC  CONSTANTS--! LO=A) 


-NAME TYPE VALUE 

RMAX  INTEGER  20 


-PHOCEDURES--(LO=A) 

-NAME TYPE ARGS  — CLASS 

DETERM  REAL  2 FUNCTION 

ERROR  1 SUBROUTINE 

SETUP  0 SUBROUTINE 


-STATEMENT  LABELS-- ( LO=A ) 


LABEL- 

ADDRESS 

--PROPERTIES- 

---DEF 

-LABEL 

-ADDRESS 

--PROPERTIES--- 

-DEF 

50 

INACTIVE 

37 

3 10 

INACTIVE 

DO-TERM 

59 

100 

22B 

43 

350 

107B 

66 

200 

INACTIVE 

DO-TERM 

48 

400 

INACTIVE 

DO-TERM 

72 

300 

INACTIVE 

DO-TERM 

50 

500 

INACTIVE 

DO-TERM 

79 
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-ENTRY  POINTS--(LO=A) 

-NAME ADDRESS --ARCS- -- 

ECALC  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

230B 

= 152 

CM  LABELLED  COMMON  LENGTH 

2 335B 

= 1245 

CM  STORAGE  USED 

61000B 

= 2508B 

COMPILE  TIME 

0.101 

SECONDS 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
1 1 
12 

13 

14 

15 
U 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 
38 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 


SUBROUTINE  PPWR  PPWR 

**»  COMMON  FOR  INITIAL  PARAMETERS  ***COMF 

**«i*******fiik<i<i«ik«iti«**«i****«****t**it*«<i««it*«[*****ii*4i*«****)k*******  + *x  + t)*cOMF 


INTEGER  FMAX  COMF 

PARAMETER  (FMAX  = 50)  COMF 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR,  COMF 

$ FTOT  COMF 

COMMON  /INITILC/  BLDG  COMF 

CHARACTER  * 5 BLDG  COMF 

REAL  FREQ,  AFLAC,  RFLAG,  FREQA  COMF 

INTEGER  QUALITY,  FERR,  FTOT  COMF 

*K*A**tit)tttt**k*4Ml******lk<tltA*1t***lt***)l****iit**i*A*<ilt*il(*lk*tk1l:***4iA*******)tA*k(20^F 

t*****lt*t*t***1tt*t**t1i*1tt********1it1tt*1t****t*'k***tiiit1i**tttt*******t*tt*  * COMR 
***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  ***COMR 

INTEGER  RMAX  COMR 

PARAMETER  (RMAX  = 20)  COMR 

COMMON  /ROOMN/  ROOM (RMAX  + 6,  RMAX  +6),  NROOMS , RAREA(RMAX)  COMR 

INTEGER  NROOMS  COMR 

REAL  ROOM  COMR 


*****  « * I 


************************************************************************  COMR 


****************************************************************  COM J 

* COMJ 

* COMMON  FOR  EVALUATION  OF  ROOM  MATRIX  COMJ 

» COMJ 

****************************************************************  COMJ 

COMMON  /MAT/TMAT(RMAX,RMAX) ,ENERGY(RMAX) ,POWER(6) ,FTIME  COMJ 

+,SWR(RMAX,6) ,IDIR  COMJ 

REAL  TMAT  , ENERGY , POWER , SWR  COMJ 

LOGICAL  FTIME  COMJ 

REAL  DB  PPWR 

WRITE!*, 20)  FREQ  PPWR 

20  FORMAT  (/"  POWER  BY  DIRECTION  1-6  AT  A FREQUENCY  OF",1PE10.3,"  PPWR 
+H2")  PPWR 

WRITE  (*,30)  (POWER(I) ,1=1 ,6)  PPWR 

30  FORMAT  ( " 1 2 3 4 5 PPWR 

+ 6",  /,"  ********************************************************* PPWR 


+ *****",/,  6( 3X  , F7  . 2)  , / , ) 

WRITE  (*,40) 

40  FORMAT!"  ROOM  ENERGY  DB  ",/, 

4.  "***************************************") 

DO  100  ICOL=l , NROOMS 

DB=10.0  * ALOGIO  ( ENERGY!  ICOL)  / 10.  ) 

100  WRITE!*, 50)  ICOL,  ENERGY  (ICOL),  DB 
50  FORMAT!  3X , I 3 , 5X , F 10  . 2 , 5X  , F 1 0 . 2 ) 

RETURN 

END 


PPWR 

PPWR 

PPWR 

PPWR 

PPWR 

PPWR 

PPWR 

PPWR 

PPWR 

PPWR 


1 

1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
11 
12 
13 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 

1 

2 

3 

4 

5 

6 

7 

8 
9 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 


-VARIABLE 

MAP-- 

(LO=A) 

-NAME---ADDRESS 

--BLOCK PROPERTIES 

TYPE 

---SIZE 

AFLAG 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

DB 

147B 

REAL 

ENERGY 

620B 

/MAT/ 

REAL 

20 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTIME 

6S2B 

/MAT/ 

LOGICAL 

FTOT 

67B 

/ INITILN/ 

INTEGER 
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I 

150B 

INTEGER 

ICOL 

151B 

INTEGER 

IDIR 

1 043B 

/MAT/ 

INTEGER 

NROOMS 

1 244B 

/ROOMN/ 

INTEGER 

POWER 

444B 

/MAT/ 

REAL 

4 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

RAREA 

1 245B 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

474 

SWR 

453B 

/MAT/ 

REAL 

1 20 

TMAT 

OB 

/MAT/ 

REAL 

400 

-SYMBOLIC  CONSTANTS-- (LO=A) 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

RMAX  INTEGER  20 


-PROCEDURES--(LO=A) 

-NAME TYPE ARGS CLASS 

ALOGIO  REAL  1 INTRINSIC 


-STATEMENT  LABELS-- ( LO=A ) 


-LABEL- 

ADDRESS-- 

---PROPERTI ES 

-DEF 

20 

55B 

FORMAT 

34 

30 

45B 

FORMAT 

39 

40 

105B 

FORMAT 

43 

50 

117B 

FORMAT 

48 

100 

INACTIVE 

DO-TERM 

47 

-ENTRY 

POINTS--(LO=A) 

-NAME-- 

-ADDRESS- 

-ARGS 

PPWR 

5B 

0 

-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


155B  = 109 

2426B  = 1302 

61000B  = 25088 

0.075  SECONDS 
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1 SUBROUTINE  PTMAT 

2 C»*  PRINTOUT  THE  CONTENTS  OF  THE  ROOM  MATRIX 

3 *•**««*««***«** 

4 »»*  COMMON  FOR  INITIAL  PARAMETERS 

5 * « * It  * 

6 INTEGER  FMAX 

7 PARAMETER  (FMAX  = 50) 

8 COMMON  /INITILN/  FREQ,  QUALITY 

$ FTOT 

COMMON  /INITILC/  BLDG 
CHARACTER  * 5 BLDG 
REAL  FREQ,  AFLAC,  RFLAG,  FREQA 
INTEGER  QUALITY,  FERR,  FTOT 


AFLAC,  RFLAG,  FREQA(FMAX),  FERR, 


9 

1 0 
11 
1 2 

13 

14  »« 

15 
U 
17 

16 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 


PTMAT 
PTMAT 

***COMF 

COMF 
COMF 
COMF 
COMF 
COMF 
COMF 
COMF 
COMF 


< * : 

****ltlt*ltlt*ltltft*<ilt*ltlt**ll****lt*ltltltit*«tt**ltltt*tt***lt<I**l[*lt**tlt*ltlt*****k*lkltlt*A*QO]^{{ 


COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS 


»**COMR 


INTEGER  RMAX 
PARAMETER  (RMAX  = 20) 

COMMON  /ROOMN/  ROOM(RMAX  + 6,  RMAX  + 6),  NROOMS , RAREA(RMAX) 

INTEGER  NROOMS 
REAL  ROOM 

***itititit*it*)titA*(iititit*A**it*it*i**iitititii*ititiiititititit**ititiii*it)t**«ii(*ii*it)tit*it**ititiiiiitiiit*it  CO  MR 

lttttlt4ltt1llltltltltltlt***A*ltltltlt*]tltllltltttllttttltAII**lt<tltltllltlMI*ltIklI*«lt*1t*lllt*«IIIIIlltll 

« 

* COMMON  FOR  EVALUATION  OF  ROOM  MATRIX 

« 

1i1it*****1i*t**ii**1i*t*1i1i1i*ii*1it*1i**tiit1tt1it1i*1i1i****i(tt1t**ti(**li**t1i*t 

COMMON  /MAT/TMAT( RMAX, RMAX) , ENERGY ( RMAX ) ,POWER(6) ,FTIME 
+ ,SWR(RMAX , 6 ) , IDIR 
REAL  TMAT  , ENERGY , POWER , SWR 
LOGICAL  FTIME 
INTEGER  R,C 
PRINT* 

PRINT*,'  TMAT  MATRIX  VALUES  ' 

PRINT*,'  AT  FREQUENCY  = ',FREQ,'  HERTZ' 


COMR 

COMR 

COMR 

COMR 

COMR 


COMJ 

COMJ 

COMJ 

COMJ 

COMJ 

COMJ 

COMJ 

COMJ 

COMJ 

PTMAT 

PTMAT 

PTMAT 

PTMAT 


PRINT* , ' 

^tttt********* < 

DO  10  R = 1, NROOMS 
PRINT  100 , (TMAT(R,C) , 
10  CONTINUE 


C = 1,  NROOMS  ) 


i»********it***»*»  * PTMAT 
PTMAT 
PTMAT 
PTMAT 
PTMAT 

PRINT* , ' ==================================== ======================PTMAT 

►============='  PTMAT 

PTMAT 
PTMAT 
PTMAT 


100  FORMAT! IX , 12 (E  12  . 6) 
RETURN 
END 


1 

2 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 
1 1 
12 
13 
1 
2 

3 

4 

5 

6 

7 

8 
9 

10 

1 

2 

3 

4 

5 

6 

7 

8 
9 
6 

7 

8 
9 

10 
11 
12 
13 
1 4 
15 
1 6 
17 
1 8 
19 


VARIABLE 

MAP-- 

(LO=A) 

NAME---ADDRESS 

--BLOCK PROPERTIES 

- --TYPE 

SIZE 

AFLAC 

2B 

1 INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

C 

146B 

INTEGER 

ENERGY 

620B 

/MAT/ 

REAL 

20 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTIME 

6S2B 

/MAT/ 

LOGICAL 

FTOT 

67B 

/ INITILN/ 

INTEGER 

IDIR 

1 043B 

/MAT/ 

INTEGER 

NROOMS 

1244B 

/ROOMN/ 

INTEGER 
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POWER 

6 44B 

/MAT/ 

REAL 

6 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

145B 

INTEGER 

RAREA 

1 245B 

/ROOMN/ 

REAL 

20 

HFLAG 

3B 

/ INITILN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

SWR 

653B 

/MAT/ 

REAL 

120 

TMAT 

OB 

/MAT/ 

REAL 

4 00 

-SYMBOLIC  CONSTANTS--(LO=A) 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

RMAX  INTEGER  20 


-STATEMENT  LABELS--! LO=A) 

-LAB  EL -ADDRESS PROPERTI  ES DEF 

10  INACTIVE  DO-TERM  43 

100  113B  FORMAT  46 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS-- ARGS--- 

PTMAT  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


153B  = 107 

2426B  = 1302 

61000B  = 25088 

0.068  SECONDS 
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1 SUBROUTINE  DFACTOR  DFACTOR 

2 * t t****t**tii*****tt****ttt*tt*tiittt***t  tut**  ******  tt**t  *****%****** 

3 •»»  COMMON  FOR  INITIAL  PARAMETERS  **«COMF 

5 INTEGER  FMAX  COMF 

i PARAMETER  (FMAX  = 50)  COMF 

7 COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX),  FERR,  COMF 

e $ FTOT  COMF 

9 COMMON  /INITILC/  BLDG  COMF 

10  CHARACTER  * 5 BLDG  COMF 

11  REAL  FREQ,  AFLAG,  RFLAG,  FREQA  COMF 

12  INTEGER  QUALITY,  FERR,  FTOT  COMF 

13  «*il*««ll<Ml*X«**lt***«**********)t****ttfktt****D*lt***lkltlk***1kA***lk******ttlt)ttt)t<iltCOt^p 

U »»»  COMMON  FOR  DATABASE  OF  LOCATIONS  OF  DOORS  AND  WINDOWS  ***COMH 

18  INTEGER  HMAX  COMH 

19  PARAMETER  (HMAX  = 35)  COMH 

20  COMMON  /HOLEN/  HTOT,  HERR  COMH 

21  COMMON  /HOLEC/  HOLE(HMAX,4)  COMH 

22  INTEGER  HTOT,  HERR  COMH 

23  CHARACTER  * 3 HOLE  COMH 

24  * ==================================================  COMH 

25  • DESCRIPTION  OF  ARRAYS  COMH 

26  » ==================================================  COMH 

27  * ROOM  IDENTIFICATION  APERTURE  ID  COMH 

28  * COMH 

29  * DIRECTION  FROM  ROOM  TO  ROOM  COMH 

30  » COMH 

31  * HOLE(X,l)  HOLE(X,2)  HOLE(X,3)  HOLE(X,4)  COMH 

32  » A3  A3  A3  A3  COMH 

36  ***  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  **»COMT 

38  INTEGER  TMAX  COMT 

39  PARAMETER  (TMAX=35)  COMT 

40  COMMON  /TYPEN/TDIM(TMAX, 4) ,TTOT,TDB2(TMAX,2) ,TDBTOT,TERR  COMT 

41  COMMON  /TYPEC/TYPE(TMAX, 3) ,TDB1 (TMAX)  COMT 

42  INTEGER  TTOT , TDBTOT , TERR  COMT 

43  REAL  TDIM,TDB2  COMT 

44  CHARACTER  * 3 TYPE.TDBl  COMT 

45  *=================================================  COMT 

46  * DESCRIPTION  OF  ARRAYS  COMT 

47  *=================================================  COMT 

48  * ID  MATERIAL  FRAME  MATERIAL  COMT 

49  * COMT 

50  *TYPE(X,1)  TYPE(X,2)  TYPE(X,3)  COMT 

51  * A3  A3  A3  COMT 

52  »=================================================  COMT 

53  * HEIGHT  WIDTH  LAYER  DISTANCE  COMT 

54  * THICKNESS  ABOVE  FLOOR  COMT 

55  * COMT 

56  * TDIM(X,1)  TDIM(X,2)  TDIM(X,3)  TDIM(X,4)  COMT 

57  » F8.2  F8.2  F8 . 2 F8 . 2 COMT 

58  *=================================================  COMT 

59  * ID  ATTENUATION  AREA  COMT 

60  * COMT 

61  * TDBl(X)  TDB2(X,1)  TDB2(X,2)  COMT 

62  * A3  E9.3  E9 . 3 COMT 

^3  ***«*«*«**********«*«***)k**********tk«****)Mt*******«i*»**««t**«**t«t««***  *COMT 
84  ************************************************************************ COMT 


1 

1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

11 

12 

13 

1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

1 1 

12 

13 

14 

15 

16 

17 

18 

19 

20 

1 

2 

3 

4 

5 

6 

7 

8 

9 

10 

1 1 

12 

13 

14 

15 

16 

17 

18 

19 

20 

21 

21 

23 

24 

25 

26 

27 

28 

29 

30 
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6 5 **»**«**»***********»***»»*»»»*»»****************«»****»**»**»**,»,,**, 

66  ***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  ***COMR 

6 7 ***»***»**«********»**»»***»*»*»*******»*»»********»»*»»***»»****,**,, 

68  INTEGER  RMAX  COMR 

69  PARAMETER  (RMAX  = 20)  COMR 

70  COMMON  /ROOMN/  ROOM (RMAX  + 6,  RMAX  +6),  NROOMS , RAREA(RMAX)  COMR 

71  INTEGER  NROOMS  COMR 

72  REAL  ROOM  COMR 

73  t**********************************************************************  * COMR 

74  *********************************************«r********«t*****itt**********cOMR 

75  «*  *************************** ***************************** ********** ****C0MV 

76  ***  COMMON  FOR  DATABASE  OF  WALL  PARAMETERS  ***COMW 

77  *****************  ******************************************************  *cOMW 

78  INTEGER  WMAX  COMW 

79  PARAMETER  (WMAX  = 75)  COMW 

80  COMMON  /WALLN/  WD IN ( WMAX , 3 ) , WTOT,  WERR  COMW 

81  COMMON  /WALLC/  WALL(WMAX,4)  COMW 

82  INTEGER  WTOT, WERR  COMW 

83  REAL  WDIN  COMW 

84  CHARACTER  *3  WALL  COMW 

85  * =================================  COMW 

86  **  DESCRIPTION  OF  ARRAYS  COMW 

87  * =================================  COMW 

88  * WALL  IDENTIFICATION  COMW 

89  * COMW 

90  * DIRECTION  FROM  TO  COMW 

91  * ROOM  ROOM  COMW 

92  * COMW 

93  * WALL(X,1)  WALL(X,2)  WALL(X,3)  COMW 

94  * A3  A3  A3  COMW 

95  * =========================================================  COMW 

96  * WALL  PARAMETERS  COMW 

97  * COMW 

98  * MATERIAL  HEIGHT  WIDTH  LAYER  THICKNESS  COMW 

99  * COMW 

100  * WALL(X,4)  VDIM(X,1)  WDIM(X,2)  WDIN(X,3)  COMW 

101  * A3  F8.2  F8.2  F8 . 2 COMW 

102  ********************************************** ************************«*C0MW 

103  «*A*A1h1kA«jtA***««*«***]lr*«***ft**«ft***AftA*)k««***lkt**Jt«***A**tA*A**«*A1tfl***  *COMW 

104  **A«*******t*«**AA******«***«******ftA*******«*«*«**«*«***«*lt**«*ft*t*«*ft*  COMD 

105  * COMMON  FOR  ABSORPTION  AND  REFLECTION  COEFFICIENTS  IN  WALLS  COMD 

106  **ft*A**A****A***ft«t*A*ft*A**AtMt*****ft***ftft*A***ft*****tAftt1k*A**1t*A**tlt****  * COMD 

107  COMMON  /ROOMD/DDABS(RMAX  + 6,  RMAX  + 6 ) ,DREFL,  DREFLW  COMD 

108  REAL  DDABS  ,DREFL  , DREFLW  COMD 

109  ************************************************************************COMD 

110  *********************************************************************** * COMD 

111  INTEGER  NEXT,  LAST,  R,  ROW  DFACTOR 

112  REAL  AFACTOR ,DREFLT  DFACTOR 

113  REAL  WATTEN,LATTEN,OATTEN,MATTEN,ATTEN,T,S,TS,TS2  DFACTOR 

114  REAL  HEIGHT, WIDTH, AREA, OAREA,WAREA  DFACTOR 

115  CHARACTER  * 3 FROM,  TO,  MAT,  ID  DFACTOR 

116  LOGICAL  NEWWALL,WALLEND  DFACTOR 

117  ***  DFACTOR 

118  ***  THIS  ROUTINE  CALCULATES  THE  ABSORPTION  OF  THE  WALL  AND  EACH  DFACTOR 

119  ***  OPENING  IN  THE  WALL,  LAYER  BY  LAYER,  AND  THEN  CALCULATES  THE  DFACTOR 

120  ***  COMPOSITE  ABSORPTION  BY  WEIGHTING  BY  AREA  EACH  OPENING'S  ABSORPTION  DFACTOR 

121  ***  AND  THE  WALL  ABSORPTION.  DFACTOR 

122  »**  FOR  REFLECTIONS,  THE  ABSORPTION  IS  DECREASED  BY  "DREFL"  IF  DFACTOR 

123  ***  THE  WALL  HAS  A REFLECTION  COEFFICIENT  GREATER  THAN  0.80  AND  DFACTOR 

124  ***  THE  ROOM  HAS  A RESONANCE.  DFACTOR 

125  ***  DFACTOR 

126  ***  VARIABLE  DEFINITIONS;  DFACTOR 

127  ***  DREFLT:  EQUALS  DREFL  IF  RESONANCE,  OTHERWISE  ZERO  DFACTOR 

128  ***  IT  REPRESENTS  REFLECTION  GAINS  DFACTOR 
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1 27 

t t « 

WATTEN.  WALL  ATTENUATION 

DFACTOR 

26 

130 

« t t 

OATTEN:  OPENING  ATTENUATION 

DFACTOR 

27 

131 

« A t 

LATTEN:  LAYER  ATTENUATION 

DFACTOR 

28 

132 

ttt 

MATTEN:  MATERIAL  ATTENUATION 

DFACTOR 

29 

133 

tun 

MAT:  MATERIAL  IDENTIFICATION 

DFACTOR 

30 

134 

t tt 

WALL:  WALL  ARRAY  CONTAINING  WALL  IDENTIFICATION  AND  MATERIAL 

DFACTOR 

31 

135 

1 1 1 

WDIM:  WALL  ARRAY  CONTAINING  PHYSICAL  DIMENSIONS  OF  THE  WALL 

DFACTOR 

32 

1 38 

1 1 1 

WMAX:  MAXIMUM  SIZE  OF  WALL  AND  WDIM  ARRAYS 

DFACTOR 

33 

137 

t tt 

WTOT:  TOTAL  LINES  OF  DATA  IN  THE  THE  WALL  AND  WDIM  ARRAYS. 

DFACTOR 

34 

138 

t tt 

HEIGHT;  HEIGHT  OF  WALL 

DFACTOR 

35 

139 

1 1 1 

WIDTH:  WIDTH  OF  WALL 

DFACTOR 

36 

140 

t tt 

T:  THICKNESS  OF  WALL 

DFACTOR 

37 

141 

1 1 1 

AREA:  AREA 

DFACTOR 

38 

1 42 

ttt 

WAREA:  TOTAL  WALL  AREA  WITHOUT  SUBTRACTING  OPENINGS. 

DFACTOR 

39 

143 

ttt 

OAREA:  TOTAL  AREA  OF  THE  OPENINGS. 

DFACTOR 

40 

144 

ttt 

NEWWALL:  TRUE  IF  DATA  LINE  BELONGS  TO  A NEW  WALL 

DFACTOR 

41 

145 

ttt 

WALLEND.  TRUE  IF  DATA  LINE  IS  THE  LAST  DATA  LINE  OF  A WALL 

DFACTOR 

42 

146 

ttt 

DFACTOR 

43 

147 

DO  10  R = l,WTOT 

DFACTOR 

44 

148 

ttt 

DFACTOR 

45 

149 

t * t 

SET  WALLEND  CONDITION 

DFACTOR 

46 

150 

NEXT  = R + 1 

DFACTOR 

47 

151 

IF  (R  .EQ.  WTOT)  THEN 

DFACTOR 

48 

152 

WALLEND  = .TRUE. 

DFACTOR 

49 

153 

ELSE  IF  ( WALL(R,2)  .NE.  WALL(NEXT,2)  .OR. 

DFACTOR 

50 

154 

Z WALL(R,3)  .NE.  WALL(NEXT,3)  ) THEN 

DFACTOR 

51 

155 

WALLEND  = .TRUE. 

DFACTOR 

52 

156 

ELSE 

DFACTOR 

53 

157 

WALLEND  = .FALSE. 

DFACTOR 

54 

158 

END  IF 

DFACTOR 

55 

159 

ttt 

DFACTOR 

56 

160 

ttt 

SET  NEWWALL  CONDITION 

DFACTOR 

57 

16  1 

LAST  = R - 1 

DFACTOR 

58 

162 

IF  (R  .EQ.  1)  THEN 

DFACTOR 

59 

163 

NEWWALL  = .TRUE. 

DFACTOR 

60 

164 

ELSE  IF  { WALL(R,2)  .NE.  WALL(LAST,2)  .OR. 

DFACTOR 

61 

165 

Z WALL<R,3)  .NE.  WALL(LAST,3)  ) THEN 

DFACTOR 

62 

166 

NEWWALL  = TRUE. 

DFACTOR 

63 

167 

ELSE 

DFACTOR 

64 

168 

NEWWALL  = .FALSE. 

DFACTOR 

65 

169 

END  IF 

DFACTOR 

66 

170 

ttt 

DFACTOR 

67 

17  1 

ttt 

CALCULATE 

DFACTOR 

68 

172 

IF  (NEWWALL)  THEN 

DFACTOR 

69 

173 

C* 

..INITIALIZE  WALL  CONDITIONS 

DFACTOR 

70 

174 

DREFLT  =0.0 

DFACTOR 

71 

175 

TS  = 0 

DFACTOR 

72 

176 

TS2  = 0 

DFACTOR 

73 

177 

WATTEN  = 0 

DFACTOR 

74 

178 

END  IF 

DFACTOR 

75 

179 

Ik  A * 

..CALCULATE  ATTENUATION  FACTOR  OF  LAYER 

DFACTOR 

76 

180 

MAT  = WALL (R, 4) 

DFACTOR 

77 

181 

MATTEN  = ATTEN  (MAT , FREQ , AF LAG ) 

DFACTOR 

78 

182 

CALL  RESONW  (WALL (R, 2)  , MAT) 

DFACTOR 

79 

183 

IF(DREPL.GT.O. 0)  DREFLT  = DREFL 

DFACTOR 

80 

184 

LATTEN  = MATTEN  * WDIH(R,3) 

DFACTOR 

81 

185 

ttt 

..CALCULATE  RUNNING  AFACTOR  OF  WALL 

DFACTOR 

82 

186 

WATTEN  = WATTEN  + LATTEN 

DFACTOR 

83 

187 

IF  (WALLEND)  THEN 

DFACTOR 

84 

188 

FROM  = WALL(R,2) 

DFACTOR 

85 

189 

TO  = WALL(R, 3) 

DFACTOR 

86 

190 

ttt 

...CALCULATE  WEIGHTED  AFACTOR  OF  OPENINGS 

DFACTOR 

87 

191 

ttt 

...AND  TOTAL  AREA  OF  OPENINGS 

DFACTOR 

88 

192 

OAREA  = 0 

DFACTOR 

89 
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1 93 

DO  20  ROW  = 1,  HTOT 

DFACTOR 

90 

194 

IF  (HOLE(ROW,2)  . EQ . FROM  .AND. 

HOLE(ROW,3)  .EQ.  TO)  THEN 

DFACTOR 

91 

195 

ID  = HOLE(ROW,4> 

DFACTOR 

92 

196 

CALL  SRCHTDBdD,  OATTEN.AREA) 

DFACTOR 

93 

197 

OAREA  = OAREA  + AREA 

DFACTOR 

94 

198 

IF  (OATTEN  .LE.  120)  THEN 

DFACTOR 

95 

199 

T = 1.0  - 10*»( -OATTEN  / 

10  ) 

DFACTOR 

96 

200 

ELSE 

DFACTOR 

97 

20  1 

T = 1 . 0 

DFACTOR 

98 

202 

END  IF 

DFACTOR 

99 

203 

S = AREA 

DFACTOR 

100 

204 

TS  = TS  + T » S 

DFACTOR 

1 01 

205 

TS2  = TS2  + T * S * S 

DFACTOR 

102 

206 

END  IF 

DFACTOR 

1 03 

207 

20 

CONTINUE 

DFACTOR 

104 

208 

* «* 

...CALCULATE  TOTAL  WALL  AREA 

DFACTOR 

1 05 

209 

HEIGHT  = UDIM(R, 1) 

DFACTOR 

106 

2 10 

WIDTH  = WDIM(R,2) 

DFACTOR 

107 

211 

WARE A = HEIGHT  * WIDTH 

DFACTOR 

108 

212 

S = WAREA  - OAREA 

DFACTOR 

1 09 

213 

IF  (WATTEN  .LE.  12  0.  ) THEN 

DFACTOR 

no 

214 

T = 1.0  - 10** (-WATTEN  / 10) 

-DREFLT 

DFACTOR 

1 11 

215 

ELSE 

DFACTOR 

112 

216 

T = 1 . 0 - DREFLT 

DFACTOR 

1 13 

217 

END  IF 

DFACTOR 

114 

218 

IFCT.LT.O  .0)  T=0  .0 

DFACTOR 

1 15 

219 

ttt 

...CALCULATE  COMPOSITE  ATTENUATION 

FACTOR  OF  WALL 

DFACTOR 

116 

220 

TS  = TS  + T * S 

DFACTOR 

1 17 

22  1 

TS2  ■•=  TS2  + T * S * S 

DFACTOR 

118 

222 

tut 

...INSERT  COMPOSITE  ATTENUATION  OF 

WALL  INTO  ROOM  MATRIX 

DFACTOR 

1 19 

223 

CALL  LDDABS  (TS , TS2 , FROM , TO ) 

DFACTOR 

120 

224 

END  IF 

DFACTOR 

1 21 

225 

10 

CONTINUE 

DFACTOR 

122 

226 

RETURN 

DFACTOR 

1 23 

227 

END 

DFACTOR 

124 

VARIABLE 

MAP-- 

(LO=A) 

NAME---ADDRESS 

--BLOCK 

-PROPERTIES 

TYPE 

AFACTOR 

NONE 

UNUSED/*S* 

REAL 

AFLAG 

2B 

/ INITILN/ 

REAL 

AREA 

446B 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

DDABS 

OB 

/ROOMD/ 

REAL 

DREFL 

1 244B 

/ROOMD/ 

REAL 

DREFLT 

433B 

REAL 

DREFLW 

1 245B 

/ROOMD/ 

REAL 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

FROM 

45  IB 

CHAR*3 

FTOT 

67B 

/ INITILN/ 

INTEGER 

HEIGHT 

444B 

REAL 

HERR 

IB 

/HOLEN/ 

INTEGER 

HOLE 

OB 

/HOLEC/ 

CHAR*3 

HTOT 

OB 

/HOLEN/ 

INTEGER 

ID 

454B 

CHAR*3 

LAST 

430B 

INTEGER 

LATTEN 

435B 

REAL 

MAT 

45  3B 

CHAR*3 

MATTEN 

437B 

REAL 

NEWWALL 

455B 

LOGICAL 

NEXT 

42  7B 

INTEGER 

-SIZE 


6U 


50 


140 
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NROOMS 

1 2 4 4B 

/ROOMN/ 

INTEGER 

OAREA 

44  7B 

REAL 

OATTEN 

436B 

REAL 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

43  IB 

INTEGER 

RAREA 

1 2 4 5B 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

ROW 

43  2B 

INTEGER 

S 

44  IB 

REAL 

T 

44  0B 

REAL 

TDBTOT 

32  3B 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

35 

TDB2 

215B 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

140 

TERR 

32  4B 

/TYPEN/ 

INTEGER 

TO 

45  2B 

CHAR*3 

TS 

442B 

REAL 

TS2 

44  3B 

REAL 

TTOT 

21  4B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

105 

WALL 

OB 

/WALLC/ 

CHAR*3 

300 

WALLEND 

45  6B 

LOGICAL 

VAREA 

45  0B 

REAL 

WATTEN 

43  4B 

REAL 

WDIM 

OB 

/WALLN/ 

REAL 

225 

WERR 

34  2B 

/WALLN/ 

INTEGER 

WIDTH 

44  5B 

REAL 

WTOT 

34  IB 

/WALLN/ 

INTEGER 

-SYMBOLIC  CONSTANTS-- (LO=A) 


-NAME-- 

--TYPE 

VALUE 

FMAX 

INTEGER 

50 

HMAX 

INTEGER 

35 

RMAX 

INTEGER 

20 

TMAX 

INTEGER 

35 

WMAX 

INTEGER 

75 

-PROCEDURES--(LO=A) 
-NAME TYPE 

--ARGS 

CLASS 

ATTEN  REAL 

3 

FUNCTION 

LDDABS 

4 

SUBROUTINE 

RESONW 

2 

SUBROUTINE 

SRCHTDB 

3 

SUBROUTINE 

-STATEMENT  LABELS-- ( LO=A ) 
-LABEL-ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  225 

20  INACTIVE  DO-TERM  207 


/ 
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-ENTRY  POINTS--(LO=A) 

-NAME ADDRESS-- ARCS 

DFACTOR  5B  0 


-STAT1STICS-- 


PROGRAM-UNIT  LENGTH 

463B 

= 307 

CM  LABELLED  COMMON  LENGTH 

4000B 

= 20  48 

CM  STORAGE  USED 

63000B 

= 26112 

COMPILE  TIME 

0 .230 

SECONDS 
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1 

2 

3 

4 

5 

6 

7 

8 
7 

1 0 
1 1 
12 

13 

14 

15 
1 6 
17 
1 8 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 

51 

52 

53 

54 

55 

56 

57 

58 

59 

60 
61 
62 

63 

64 


SUBROUTINE  LDDABS  ( TS , TS2 , FROM,  TO  ) LDDABS 

* THIS  ROUTINE  LOADS  THE  ABSORPTION  COEFFICIENT  INTO  THE  APPROPRIATE  LDDABS 

* LOCATION  IN  THE  'DDABS'  ARRAY.  LDDABS 

* LDDABS 

* NROOMS:  TOTAL  NUMBERS  OF  ROOMS  REPRESENTED  BY  DATA  LDDABS 

* RMAX:  MAXIMUM  NUMBER  POSSIBLE  UNDER  THE  PRESENT  PROGRAM  CONFIGURATIOLDDADS 

» TS  AND  TS2:  ABSORPTION  COEFFICIENTS  LDDABS 

* FROM:  TO:  CONTAINS  ROOM#'S  OR  THE  DIRECTIONS  D 1 , D2 , 4 , D5 , OR  D6 . LDDABS 

t**********************************************************************  * COMR 
*»*  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  ***COMR 

i*lt*i>i*1iifHIA***«*4IAtt«X*AI)it*))*4tltlk)kAik*lt*1tAA*1li*llitt<IA***lklk**k*************lk****  C OMR 
INTEGER  RMAX  COMR 

PARAMETER  (RMAX  = 20)  COMR 

COMMON  /ROOMN/  ROOM(RMAX  + 6,  RMAX  +6),  NROOMS,  RAREA(RMAX)  COMR 

INTEGER  NROOMS  COMR 

REAL  ROOM  COMR 

* COMMON  FOR  ABSORPTION  AND  REFLECTION  COEFFICIENTS  IN  WALLS  COMD 

COMMON  /ROOMD/DDABS(RMAX  + 6,  RMAX  + 6 ) ,DREFL,  DREFLW  COMD 

REAL  DDABS  ,DREFL  , DREFLW  COMD 

tt*ltii***lili******l(**iiii*it*liii*****li**ii*t*li**t*tt*iilili**li***tii***iitii*****tt**Q  OMD 

INTEGER  VAL,  C,  R,  RNUM,  D LDDABS 

REAL  TS,  TS2  LDDABS 

CHARACTER  * 3 FROM,  TO  LDDABS 

IF  ( FROM(l:l)  . EQ . 'D'  ) THEN  LDDABS 

RNUM  = VAL  ( TO(l:2)  ) LDDABS 

D = VAL  ( FROM(2 ; 2)  ) LDDABS 

****i«*«**************«***1k«*****«*******«ilt**************)[****«Ik*l«*******[,OQ;^BS 

* INSERT  ABSORPTION  COEFFICENT  FOR  ENERGY  ENTERING  A ROOM  FROM  THE  LDDABS 

* OUTSIDE  OF  THE  BUILDING.  LDDABS 

R = NROOMS  + D LDDABS 

C = RNUM  LDDABS 

DDABS(R,C)  = TS  + DDABS(R,C)  LDDABS 

***********ik********x***x******************«***«*iii*****«*«*it*******«****[.[)]3;^BS 

* INSERT  ABSORPTION  COEFFICIENT  INTO  'DDABS'  ARRAY  FOR  ENERGY  LEAVING  LDDABS 

* A ROOM  TO  THE  OUTSIDE  OF  THE  BUILDING.  LDDABS 

R = RNUM  LDDABS 

C = NROOMS  + D LDDABS 

DDABS(R,C)  = TS2  / RAREA(RNUM)  + DDABS(R,C)  LDDABS 

ELSE  IF  ( TO(l:l)  . EQ . 'D'  ) THEN  LDDABS 

RNUM  = VAL  ( FROM(l:2)  ) LDDABS 

D = VAL  ( TO(2 : 2 ) ) LDDABS 

»*»*»**************x****«***»x*******»***»******»***»***»**»»»x**»x»»»t»L0o;^gS 

* INSERT  ABSORPTION  COEFFICIENT  INTO  'DDABS'  ARRAY  FOR  ENERGY  ENTER INGLDDABS 

* A ROOM  FROM  THE  OUTSIDE  OF  THE  BUILDING.  LDDABS 

XXXXXXX*XX*XXXX*X*XXX*XXX*XXXX*XXXXXXXXXXXXXX*XXXXXXXXXXXX*X*X*XX*X*XX«XLQQJ^g5 

R = NROOMS  + D LDDABS 

C = RNUM  LDDABS 

DDABS(R,C)  = TS  + DDABS(R,C)  LDDABS 

XXX*XXXXXXXXXXX*XXXX*XXXXXXXXXXX*X«X*XXXXXXX*XX*«XXX***X*XX***X«***Xl*t*gQ[]^g3 

* INSERT  ABSORPTION  COEFFICIENT  INTO  'DDABS'  ARRAY  FOR  ENERGY  LEAVING  LDDABS 

* A ROOM  TO  THE  OUTSIDE  OF  THE  BUILDING.  LDDABS 

XXXXXXXXXXXXXXXXXXXXXAXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXtXtXXXXXgQQXBS 

R = RNUM  LDDABS 


1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

1 

2 

3 

4 

5 

6 
7 

13 

14 

15 
1 6 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 
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65 

C = NROOMS  + D 

LDDABS 

SO 

66 

DDABS(R,C)  = TS2  / RAREA(RNUM)  + DDABS 

(R,C) 

LDDABS 

51 

67 

t * 

** 

*4ilk**itA**)t*lkA****ktt*A***it**it**«*Alt*«kk«lk*** 

AAAAA AAAAA 

***************I,qqXBS 

52 

68 

ELSE 

LDDABS 

53 

69 

t t 

A* 

iiM)*ttlt********i>****ltlt«)l**************fr****** 

AAAAAAAAAA 

***************I,DQAQS 

54 

70 

* 

INSERT  ABSORPTION  COEFFICIENTS  INTO  ‘DDABS* 

ARRAY  FOR 

ENERGY  GOING  LDDABS 

55 

71 

t 

FROM  ROOM  TO  ROOM. 

LDDABS 

56 

72 

t * 

A A 

********** 

*************** 

57 

73 

R = VAL  ( FROM!  1 -.2)  ) 

LDDABS 

58 

74 

C = VAL  ! TO!l  :2)  ) 

LDDABS 

59 

75 

DDABS!R,C)  = TS2  / RAREA!R)  + DDABS!R 

,C) 

LDDABS 

60 

76 

DDABS!C,R)  = TS2  / RAREA!C)  + DDABS!C 

,R) 

LDDABS 

61 

77 

END  IF 

LDDABS 

62 

78 

RETURN 

LDDABS 

63 

79 

END 

LDDABS 

64 

-VARIABLE  MAP--(LO=A) 


NAME 

ADDRESS- 

-BLOCK PROPERTIES 

TYPE 

---SIZE 

C 

222B 

INTEGER 

D 

225B 

INTEGER 

DDABS 

OB 

/ROOMD/ 

REAL 

676 

DREFL 

1 2 4 4B 

/ROOMD/ 

REAL 

DREFLW 

1 245B 

/ROOMD/ 

REAL 

FROM 

3 

DUMMY-ARG 

CHAR*3 

NROOMS 

1244B 

/ROOMN/ 

INTEGER 

R 

22  3B 

INTEGER 

RAREA 

1 245B 

/ROOMN/ 

REAL 

20 

RNUM 

22  4B 

INTEGER 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

TO 

4 

DUMMY-ARG 

CHAR*3 

TS 

1 

DUMMY-ARG 

REAL 

TS2 

2 

DUMMY-ARG 

REAL 

-SYMBOLIC  CONSTANTS--! LO=A) 


-NAME TYPE VALUE 

RMAX  INTEGER  20 


-PROCEDURES--(LO=A) 

-NAME TYPE ARCS CLASS 

VAL  INTEGER  1 FUNCTION 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS- -ARCS 


LDDABS  SB  4 


-3TATISTICS-- 


PROGRAM-UNIT  LENGTH 

230B 

= 152 

CM  LABELLED  COMMON  LENGTH 

253  7B 

= 1375 

CM  STORAGE  USED 

61000B 

= 25088 

COMPILE  TIME 

0.103 

SECONDS 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

1 0 
11 
1 2 

13 

14 

15 
U 

17 

18 

19 

20 
21 
22 

23 

24 

25 
28 

27 

28 

29 

30 

31 

32 

33 

34 

35 
38 

37 

38 

39 

40 

41 

42 

43 

44 

45 
48 

47 

48 

49 

50 

51 

52 

53 

54 

55 
58 


SUBROUTINE  PDDABS  PDDABS 

C»*  PRINTOUT  THE  CONTENTS  OF  THE  ROOM  MATRIX  PDDABS 


»•*  COMMON  FOR  INITIAL  PARAMETERS  ***COMF 


INTEGER  FMAX  COMF 

PARAMETER  (FMAX  = 50)  COMF 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX),  FERR,  COMF 

$ FTOT  COMF 

COMMON  /INITILC/  BLDG  COMF 

CHARACTER  » 5 BLDG  COMF 

REAL  FREQ,  AFLAG,  RFLAG,  FREQA  COMF 

INTEGER  QUALITY,  FERR,  FTOT  COMF 

***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  »»*COMR 

INTEGER  RMAX  COMR 

PARAMETER  (RMAX  = 20)  COMR 

COMMON  /ROOMN/  ROOM(RMAX  + 8,  RMAX  + 8),  NROOMS , RAREA(RMAX)  COMR 

INTEGER  NROOMS  COMR 

REAL  ROOM  COMR 


1 

2 

1 

2 

3 

4 

5 
8 

7 

8 
9 

10 
1 1 
12 
13 
1 
2 

3 

4 

5 
8 

7 

8 


9 

10 


« COMMON  FOR  EVALUATION  OF  ROOM  MATRIX 

* 

COMMON  / MAT /TMAT( RMAX, RMAX) , ENERGY ( RMAX ) ,POWER(6) ,FTIME 
+,SWR(RMAX, 6) , IDIR 
REAL  TMAT  , ENERGY , POWER , SWR 
LOGICAL  FTIME 

tttmitt****t**tii*ii****tii**t***ii**ttii»***t**t**t****ii*******tii***i 

* COMMON  FOR  ABSORPTION  AND  REFLECTION  COEFFICIENTS  IN  WALLS 

COMMON  /ROOMD/DDABS(RMAX  + 8,  RMAX  + 8 ) ,DREFL,  DREFLW 
REAL  DDABS  ,DREFL  , DREFLW 


INTEGER  R,C 
PRINT* 

PRINT*,'  DDABS  MATRIX  VALUES 
PRINT*,'  AT  FREQUENCY  = ',FREQ,' 
PRINT*,'  WITH  AFLAG  = ',  AFLAG, 


HERTZ ' 

PER  CENT' 


4.****lt*4MtA****  ' 

DO  10  R = 1, NROOMS  + 8 
PRINT  100 , (DDABS(R,C)  , 
10  CONTINUE 


100  FORMATdX,  12(F8  .3) 
RETURN 
END 


C = 1 , NROOMS  + 8 ) 


COMJ 

1 

COMJ 

2 

COMJ 

3 

COMJ 

4 

COMJ 

5 

COMJ 

8 

COMJ 

7 

COMJ 

8 

COMJ 

9 

1 

COMD 

2 

3 

COMD 

4 

COMD 

5 

8 

7 

PDDABS 

7 

PDDABS 

8 

PDDABS 

9 

PDDABS 

10 

PDDABS 

11 

•PDDABS 

12 

PDDABS 

13 

PDDABS 

1 4 

PDDABS 

15 

PDDABS 

18 

:PDDABS 

17 

PDDABS 

18 

PDDABS 

19 

PDDABS 

20 

PDDABS 

2i 
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-VARIABLE  MAP--(LO=A) 

-NAME ADDRESS- -BLOCK PROPERTIES TYPE SIZE 


AFLAC 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

C 

163B 

INTEGER 

DDABS 

OB 

/ROOMD/ 

REAL 

678 

DREFL 

1 244B 

/ROOMD/ 

REAL 

DREFLW 

1 245B 

/ROOMD/ 

REAL 

ENERGY 

620B 

/MAT/ 

REAL 

20 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FT  I ME 

652B 

/MAT/ 

LOGICAL 

FTOT 

87B 

/ INITILN/ 

INTEGER 

IDIR 

1 043B 

/MAT/ 

INTEGER 

NROOMS 

1 244B 

/ROOMN/ 

INTEGER 

POWER 

644B 

/MAT/ 

REAL 

6 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

R 

162B 

INTEGER 

RAREA 

1245B 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

SWR 

653B 

/MAT/ 

REAL 

120 

TMAT 

OB 

/MAT/ 

REAL 

400 

-SYMBOLIC  CONSTANTS-- (LO=A) 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

RMAX  INTEGER  20 


-STATEMENT  LABELS--! LO=A) 

-LAB  EL- ADDRESS PROPERTIES DEF 

10  INACTIVE  DO-TERM  51 

100  121B  FORMAT  54 


-ENTRY  POINTS--(LO=A> 
-NAME ADDRESS- -ARCS 

PDDABS  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


170B  = 120 

3674B  = 1980 

61000B  = 25088 

0.071  SECONDS 
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80 


1 

2 

3 

4 

5 

7 

8 
9 

1 0 
11 
1 2 
13 
1 4 
15 
1 6 

17 

18 

19 

20 
21 


IDDABS 
IDDABS 
IDDABS 

r*********************************  * COMB 

***COMR 


SUBROUTINE  IDDABS 

*******  I 

» INITIALIZE  DDABS  MATRIX, 

***************1 
*******  I 

»»»  COMMON  POR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS 

INTEGER  RMAX  COMR 

PARAMETER  (RMAX  = 20)  COMR 

COMMON  /ROOMN/  ROOMIRMAX  + 6,  RMAX  +6),  NROOMS,  RAREA(RMAX)  COMR 

INTEGER  NROOMS  COMR 

REAL  ROOM  COMR 

************************************************************************  COMR 

* COMMON  FOR  ABSORPTION  AND  REFLECTION  COEFFICIENTS  IN  WALLS  COMD 

COMMON  /ROOMD/DDABS(RMAX  + 6,  RMAX  + 6 ) ,DREFL,  DREFLW  COMD 

REAL  DDABS  ,DREFL  , DREFLW  COMD 


1 

2 

3 

4 
1 
2 

3 

4 

5 

1 

7 

8 
9 

10 

1 

2 

3 

4 

5 
i 
7 


22 

INTEGER  R,C 

IDDABS 

7 

23 

DO  10  R = l.RMAX 

IDDABS 

8 

24 

DO  10  C = 1 ,RMAX 

IDDABS 

9 

25 

DDABS(R,C)  = 0.0 

IDDABS 

10 

26 

10 

CONTINUE 

IDDABS 

11 

27 

DO  20  R = l.RMAX 

IDDABS 

12 

28 

DO  20  C = RMAX  + 1,  RMAX  + 5 

IDDABS 

13 

29 

DDABS(R,C)  = 0.0 

IDDABS 

14 

30 

20 

CONTINUE 

IDDABS 

15 

31 

RETURN 

IDDABS 

16 

32 

END 

IDDABS 

17 

-VARIABLE 

MAP-- 

(LO=A) 

-NAME ADDRESS 

--BLOCK 

--PROPERTIES 

TYPE 

SIZE 

C 

70B 

INTEGER 

DDABS 

OB 

/ROOMD/ 

REAL 

676 

DREFL 

1244B 

/ROOMD/ 

REAL 

DREFLW 

1 245B 

/ROOMD/ 

REAL 

NROOMS 

124  4B 

/ROOMN/ 

INTEGER 

R 

67B 

INTEGER 

RAREA 

1245B 

/ROOMN/ 

REAL 

20 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

-SYMBOLIC  CONSTANTS--(LO=A) 


-NAME TYPE VALUE 

RMAX  INTEGER  20 


STATEMENT  LABELS--( LO=A) 

LAB  EL -ADDRESS PROPERTIES DEF 


10 

20 


INACTIVE 

INACTIVE 


DO-TERM 

DO-TERM 


26 

30 
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-ENTRY  POINTS--(LO=A) 

-NAME ---ADDRESS --ARCS 

IDDABS  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

77B 

= 63 

CM  LABELLED  COMMON  LENGTH 

2537B 

= 1375 

CM  STORAGE  USED 

81000B 

= 25088 

COMPILE  TIME 

0.050 

SECONDS 
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1 

2 

3 

4 

5 

6 

7 

8 
7 

1 0 
1 1 
1 2 
13 
1 4 
15 
U 

17 

18 
1? 
20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 


QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR 


PPWR2 
***COMF 
**  *COMF 
***COMF 
COMF 
COMF 
COMF 
COMF 
COMF 
COMF 
COMF 
COMF 


***COMR 


SUBROUTINE  PPWR2 

t«****D«**llt**<I*<l 

**•  COMMON  FOR  INITIAL  PARAMETERS 

t«*t***« 

INTEGER  FMAX 
PARAMETER  (FMAX  = 50) 

COMMON  /INITILN/  FREQ 
0 FTOT 

COMMON  /INITILC/  BLDG 
CHARACTER  * 5 BLDG 
REAL  FREQ,  AFLAC,  RFLAG,  FREQA 
INTEGER  QUALITY,  FERR,  FTOT 
<*««*«««*****«***** 

«*««*«*****««*** 

***  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS 

***li*********i(*li*****tli***************litt***t*******li**t*1i******** 

INTEGER  RMAX 
PARAMETER  (RMAX  = 20) 

COMMON  /ROOMN/  ROOM(RMAX  + 6,  RMAX  + 6),  NROOMS , RAREA(RMAX) 

INTEGER  NROOMS 
REAL  ROOM 

t**********************************************************************  * COMR 


* 

* COMMON  FOR  EVALUATION  OF  ROOM  MATRIX 

* 

t****t**ii****t*t********tii****t***ii**»******t*ttiit**ii*iit***ititt** 

COMMON  /MAT / THAT ( RMAX , RMAX) , ENERGY ( RMAX ) ,POVER(6) ,FTIME 
+ , SWR(RMAX, 6) , IDIR 
REAL  TMAT  , ENERGY , POWER , SWR 
LOGICAL  FTIME 
REAL  DB 

WRITE!*, 30)  FREQ 

30  FORMAT  ( / / , " ATTENUATI ON  AT  A FREQUENCY  OF " , 1 PE  1 0 . 3 , " HZ" 

/ I " **»***»**»»*****»*»***************»***********"  , 
*********»*****************" 

/,"*  * DIRECTIONS  ",28X, "♦",/, 

* ROOMS  * 1 2 3 4 " , 

5 *"^/^"»********»****»**»*********»*»*t**<i»*»»»*" 

»***»***»**»******»***********»*") 

WRITE!*, 100)  ( IROW, (SWR! IROW, I) , 1=1 , 5) , I ROW= 1 , NROOMS ) 

100  FORMAT  ("*  " , 13  , 3X,  "*" , F9  . 2 , 3X ,F10 . 2 , 3X,F10 . 2 , 3X,F10 . 2 , 3X ,F10 . 2 , 
+ " *") 

WRITE  (*,120) 

120  FORMAT  ("' 

RETURN 
END 


1 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

1 

2 

3 


COMR 

4 

COMR 

5 

COMR 

6 

COMR 

7 

COMR 

8 

*COMR 

9 

10 

COMJ 

1 

COMJ 

2 

COMJ 

3 

COMJ 

4 

COMJ 

5 

COMJ 

6 

COMJ 

7 

COMJ 

8 

COMJ 

9 

PPWR2 

5 

PPWR2 

6 

PPWR2 

7 

PPWR2 

8 

PPWR2 

9 

PPWR2 

10 

PPWR2 

11 

,PPWR2 

12 

PPWR2 

13 

PPWR2 

14 

PPWR2 

IS 

PPWR2 

1 6 

PPWR2 

17 

PPWR2 

18 

PPWR2 

19 

PPWR2 

20 

PPWR2 

21 

-VARIABLE 

MAP-- 

(LO=A) 

-NAME---ADDRESS 

--BLOCK 

-PROPERTIES 

TYPE 

SIZE 

AFLAC 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

DB 

NONE 

UNUSED/*S* 

REAL 

ENERGY 

620B 

/MAT/ 

REAL 

20 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTIME 

6S2B 

/MAT/ 

LOGICAL 

FTOT 

67B 

/ INITILN/ 

INTEGER 
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I 

167B 

INTEGER 

IDIR 

1 043B 

/MAT/ 

INTEGER 

IROW 

145B 

INTEGER 

NROOMS 

1 244B 

/ROOMN/ 

INTEGER 

POWER 

444B 

/MAT/ 

REAL 

4 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

RAREA 

1 245B 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

474 

SWR 

45  3B 

/MAT/ 

REAL 

120 

TMAT 

OB 

/MAT/ 

REAL 

400 

-SYMBOLIC  CONSTANTS-- (LO=A> 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

RMAX  INTEGER  20 


-STATEMENT  LABELS-- ( LO=A) 

-LAB  EL- ADDRESS PROPERTIES DEF 

30  58B  FORMAT  34 

100  123B  FORMAT  44 

120  133B  FORMAT  47 


-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS 

PPWR2  5B  0 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 
CM  LABELLED  COMMON  LENGTH 
CM  STORAGE  USED 
COMPILE  TIME 


173B  = 123 

2424B  = 1302 

61000B  = 25088 

0.071  SECONDS 
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1 

2 

3 

4 

5 
k 

7 

8 
9 

1 0 
1 1 
12 

13 

14 

15 
U 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 


SUBROUTINE  SPUR  SPWR 

•••  COMMON  FOR  INITIAL  PARAMETERS  ***COMF 

(**«*«****«*««*««****t*******«*****«************«***ik**«*«*******««*<t**  * COMP 
INTEGER  FMAX  COMF 

PARAMETER  (FMAX  = 50)  COMF 

COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX),  FERR,  COMF 

5 FTOT  COMF 

COMMON  /INITILC/  BLDG  COMF 

CHARACTER  * 5 BLDG  COMF 

REAL  FREQ,  AFLAG,  RFLAG,  FREQA  COMF 

INTEGER  QUALITY,  FERR,  FTOT  COMF 

«**t**********«***«****«********«***********it******ik******************«*C0MR 

•»*  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  ***COMR 

INTEGER  RMAX  COMR 

PARAMETER  (RMAX  = 20)  COMR 

COMMON  /ROOMN/  ROOM(RMAX  + 6,  RMAX  + 6),  NROOMS , RAREA(RMAX)  COMR 

INTEGER  NROOMS  COMR 

REAL  ROOM  COMR 

t***************************************************************  COMJ 

» COMJ 

* COMMON  FOR  EVALUATION  OF  ROOM  MATRIX  COMJ 

» COMJ 

COMMON  /MAT/TMAT(RMAX,RMAX) ,ENERGY(RMAX) ,POVER(6) ,FTIME  COMJ 

+,SWR(RMAX,6) ,IDIR  COMJ 

REAL  TMAT  , ENERGY , POWER , SWR  COMJ 

LOGICAL  FTIME  COMJ 

REAL  DB  SPWR 

DO  100  I ROW= 1 , NROOMS  SPWR 

IF(ENERGY( IROW) . LT. 1 . OE-05)  THEN  SPWR 

DB  = -60.0  SPWR 

GO  TO  100  SPWR 

END  IF  SPWR 

DB=10.0  * ALOGIO  ( ENERGY!  IROW)  / 10.  ) SPWR 

100  SWR( IROW, IDIR) =DB  SPWR 

RETURN  SPWR 

END  SPWR 


1 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

1 

2 

3 

4 

5 

6 

7 

8 
9 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 


-VARIABLE 

MAP-- 

It 

o 

-NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

---SIZE 

AFLAG 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

DB 

SSB 

REAL 

ENERGY 

620B 

/MAT/ 

REAL 

20 

FERR 

66B 

/ INITILN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTIME 

652B 

/MAT/ 

LOGICAL 

FTOT 

67B 

/ INITILN/ 

INTEGER 

IDIR 

1 043B 

/MAT/ 

INTEGER 

IROW 

56B 

INTEGER 

NROOMS 

1 244B 

/ROOMN/ 

INTEGER 

POWER 

644B 

/MAT/ 

REAL 

6 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

RAREA 

124SB 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 
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ROOM 

OB 

/ROOMN/ 

REAL 

676 

SWR 

853B 

/MAT/ 

REAL 

120 

TMAT 

OB 

/MAT/ 

REAL 

400 

--SYMBOLIC  CONSTANTS--(LO=A) 


-NAME TYPE VALUE 

FMAX  INTEGER  50 

RMAX  INTEGER  20 


--PROCEDURES--(LO=A) 

-NAME TYPE ARGS CLASS 

ALOGIO  REAL  1 INTRINSIC 


--STATEMENT  LABELS--! LO=A) 

-LAB  EL -ADDRESS PROPERTIES DEF 

100  31B  DO-TERM  41 


--ENTRY  POINTS--! LO=A> 
-NAME---ADDRESS--ARGS--- 

SPWR  5B  0 


--STATISTICS-- 


PROGRAM-UNIT  LENGTH 

62B 

= 50 

CM  LABELLED  COMMON  LENGTH 

242  6B 

= 1302 

CM  STORAGE  USED 

61000B 

= 25088 

COMPILE  TIME 

0 .057 

SECONDS 
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1 SUBROUTINE  RE SONV ( FROM , MATI D ) RESONV 

2 • RESONV 

3 • THIS  ROUTINE  CHECKS  FOR  RESONANCE  CONDITIONS  IN  A ROOM  RESONV 

4 » IF  A RESONANCE  IS  POSSIBLE  AT  THE  PARTICULAR  FREQUENCY  RESONV 

5 « FOR  THE  ROOM  AND  THE  VALL  IN  QUESTION  HAS  A REFLECTION  RESONV 

4 • COEFFICIENT  GREATER  THAN  0.80,  THEN  THE  ABSORPTION  FOR  RESONV 

7 • THE  VALL  IS  REDUCED  BY  THE  REFLECTION  COEFFICIENT.  RESONV 

8 • RESONV 

9 *COMR 

10  •»»  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  VALLS  **»COMR 

11  *COMR 

12  INTEGER  RMAi  COMR 

13  PARAMETER  (RMAX  = 20)  COMR 

14  COMMON  /ROOMN/  ROOM(RMAX  + 4,  RMAX  + 4),  NROOMS , RAREA(RMAX)  COMR 

15  INTEGER  NROOMS  COMR 

14  REAL  ROOM  COMR 

17  *COMR 

Ig  * COMR 

19  < COMV 

20  »**  COMMON  FOR  DATABASE  OF  VALL  PARAMETERS  ***COMV 

21  * COMV 

22  INTEGER  VMAX  COMV 

23  PARAMETER  (VMAX  = 75)  COMV 

24  COMMON  /VALLN/  VD IM ( VMAX , 3 ) , WTOT,  VERR  COMV 

25  COMMON  /VALLC/  VALL(VMAX,4)  COMV 

24  INTEGER  VTOT.VERR  COMV 

27  REAL  VDIM  COMV 

28  CHARACTER  »3  VALL  COMV 

29  • =================================  COMV 

30  **  DESCRIPTION  OF  ARRAYS  COMV 

31  * =================================  COMV 

32  * VALL  IDENTIFICATION  COMV 

33  t COMV 

34  * DIRECTION  FROM  TO  COMV 

35  * ROOM  ROOM  COMV 

34  * COMV 

37  * VALL(X,1)  VALL(X,2)  VALL(X,3)  COMV 

38  » A3  A3  A3  COMV 

39  * =========================================================  COMV 

40  » VALL  PARAMETERS  COMV 

41  » COMV 

42  * MATERIAL  HEIGHT  VIDTH  LAYER  THICKNESS  COMV 

43  t COMV 

44  * VALL(X,4)  VDIM(X,1)  VDIM(X,2)  VDIM(X,3)  COMV 

45  • A3  F8.2  F8 . 2 F8.2  COMV 

44  *«*«*«*«*»*****t**«ii*«*5t«***««««<x««**«*)t«*t******t********«t««««t****t*  COMV 
47  t COMV 

43  ***tt**tt*t**t**tt****ii**t**t*t*t**t**t*t*tt*ttt*tttt*tt*t**t*t*tt*tt*t * COMF 

49  ***  COMMON  FOR  INITIAL  PARAMETERS  *»»COMF 

50  COMF 

51  INTEGER  FMAX  COMF 

52  PARAMETER  (FMAX  = 50)  COMF 

53  COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX),  FERR,  COMF 

54  $ FTOT  COMF 

55  COMMON  /INITILC/  BLDG  COMF 

54  CHARACTER  * 5 BLDG  COMF 

57  REAL  FREQ,  AFLAG,  RFLAG,  FREQA  COMF 

58  INTEGER  QUALITY,  FERR,  FTOT  COMF 

59  t*«*«*««**(*«******t**t******tt*«**t***tt***t*ttt«*(**(«*t«(«*i*tt(tttttcOMF 

40  **t*********tt*****************«**t****t*t*t«««x*t*tt>tt**t*t*t**t*ti(ttcOMF 

41  • COMM 

42  **»  COMMON  FOR  DATABASE  OF  MATERIAL  PROPERTIES  «*»COMM 

43  i**x***«**x«**««****t*««*****«x««xt*******«*t«t«t*t«**t*tt«ittt*t*t«*tt • COMM 

44  INTEGER  MMAX  COMM 


1 

2 

3 

4 

5 

4 

7 

8 

1 

2 

3 

4 

5 

4 

7 

8 

9 

10 

1 

2 

3 

4 

5 

4 

7 

8 

9 

10 

1 1 

12 

13 

14 

15 

14 

17 

18 

19 

20 

21 

22 

23 

24 

25 

24 

27 

28 

29 

1 

2 

3 

4 

5 

4 

7 

8 

9 

10 

1 1 

12 

13 

1 

2 

3 

4 
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87 


65 

PARAMETER  <MMAX=100> 

COMM 

5 

66 

COMMON  /MATN/  MATTENIMMAX , 7 ) , MRCOEF <MMAX , 7 ) , QA(MMAX),  QR(MMAX), 

COMM 

6 

67 

$ NFREQ(NMAX. 7) , MERR,  MTOT 

COMM 

7 

68 

COMMON  /MATC/MAT(MMAX) .MATDESC (MMAX > 

COMM 

8 

69 

INTEGER  MTOT,  MERR 

COMM 

9 

70 

REAL  MATTEN,  MRCOEF,  MFREQ,  QA , OR 

COMM 

10 

71 

CHARACTER  * 3 MAT 

COMM 

11 

72 

CHARACTER  * 70  MATDESC 

COMM 

12 

73 

* * A * 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftAftftftftfttftftftftftfttftftft  ft COMM 

13 

74 

* COMM 

14 

75 

A*A**A***A***il[***A****AA«**A**«****«***ft*A*«lk**«1t*1t**«****«*«*«*«ft1t«*«*  *COMD 

1 

76 

* 

COMMON  FOR  ABSORPTION  AND  REFLECTION  COEFFICIENTS  IN  WALLS 

COMD 

2 

77 

A*A**A*«*A«*«******«****«**A«ft*«*****Aft«ft**A*«t***«*«*««******«**«*  ft  **  * *COMD 

3 

78 

COMMON  /ROOMD/DDABSCRMAX  + 6,  RMAX  + 6 ) ,DREFL,  DREFLW 

COMD 

4 

79 

REAL  DDABS  ,DREFL  , DREFLW 

COMD 

5 

80 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft  ft  COMD 

6 

81 

ftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftftft  ft  COMD 

7 

82 

REAL  A,B,C,RH,RL,RW 

RESONW 

14 

83 

REAL  MREFL 

RESONW 

15 

84 

CHARACTER  * 3 FROM,MATID 

RESONW 

16 

85 

I SET  = 0 

RESONW 

17 

86 

MREFL  = RCOEF  (MATID , FREQ , RFLAG ) 

RESONW 

18 

87 

IF(MREFL.LT,0.80)  THEN 

RESONW 

19 

88 

DREFL  =0.0 

RESONW 

20 

89 

RETURN 

RESONW 

21 

90 

END  IF 

RESONW 

22 

91 

IF(FROM(l: 1)  ,EQ.  'D'  ) THEN 

RESONW 

23 

92 

DREFL  =0.0 

RESONW 

24 

93 

RETURN 

RESONW 

25 

94 

END  IF 

RESONW 

26 

95 

ft 

RESONW 

27 

96 

ft 

NOW  GET  HEIGHT,  WIDTH  AND  LENGTH  OF  ROOM 

RESONW 

28 

97 

ft 

RESONW 

29 

98 

DO  100  11  = 1,  WTOT 

RESONW 

30 

99 

IF(  FROM.EQ.WALL(Il,2)  AND.  WALL ( I 1 , 1 ) . EQ . ' FB  ')  THEN 

RESONW 

31 

100 

RH  = WDIM( 11,1) 

RESONW 

32 

101 

GOTO  200 

RESONW 

33 

102 

END  IF 

RESONW 

34 

103 

100 

CONTINUE 

RESONW 

35 

104 

DREFL  = 0 

RESONW 

36 

105 

IWARN  = 9 

RESONW 

37 

106 

CALL  WARNING! IWARN) 

RESONW 

38 

107 

RETURN 

RESONW 

39 

108 

200 

11  = 0 

RESONW 

40 

109 

300 

11  = 11  + 1 

RESONW 

41 

110 

IF(I1  GT.WTOT)  THEN 

RESONW 

42 

111 

DREFL  =0.0 

RESONW 

43 

112 

IF(  ISET. EQ. 1 ) RETURN 

RESONW 

44 

113 

IWARN  = 10 

RESONW 

45 

114 

CALL  WARNING! IWARN) 

RESONW 

46 

115 

RETURN 

RESONW 

47 

1 16 

END  IF 

RESONW 

48 

117 

IF!FROM.EQ.WALL!Il ,2)  AND.  WALL ! 1 1 , 1 ) . EQ . ' UD  ')  THEN 

RESONW 

49 

118 

RL=  WDIM! 11,2) 

RESONW 

50 

119 

RW=  WDIM! 11 , 1 ) 

RESONW 

51 

120 

ELSE 

RESONW 

52 

12  1 

GOTO  300 

RESONW 

53 

122 

END  IF 

RESONW 

54 

123 

ft 

RESONW 

55 

124 

ft 

NOW  SORT  OUT  DIMENSIONS  WITH  A SMALLEST  AND  C LARGEST 

RESONW 

56 

125 

ISET  = 1 

RESONW 

57 

126 

IPASS  = 0 

RESONW 

58 

127 

A = RH 

RESONW 

59 

128 

B = RW 

RESONW 

60 
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1 29 

C = RL 

RESONW 

6 1 

130 

500 

IF(A.GT.B)  THEN 

RESONW 

62 

13  1 

TMP=  A 

RESONW 

63 

132 

A = B 

RESONW 

64 

133 

B = TMP 

RESONW 

65 

134 

IPASS  = 0 

RESONW 

66 

135 

ELSE 

RESONW 

67 

136 

IPASS  = 1 

RESONW 

68 

137 

ENDIF 

RESONW 

69 

138 

IF  (B.GT.C)  THEN 

RESONW 

70 

139 

TMP  =B 

RESONW 

71 

140 

B = C 

RESONW 

72 

14  1 

C = TMP 

RESONW 

73 

142 

IPASS  = 0 

RESONW 

74 

143 

ENDIF 

RESONW 

75 

144 

IF  (IPASS. EQ.  0)  GOTO  500 

RESONW 

76 

145 

* 

RESONW 

77 

1 46 

NOW  CALCULATE  LOWER  RESONANCE  FREQUENCY 

RESONW 

78 

147 

CLIGHT=  3.0E08 

RESONW 

79 

148 

FLOW  = 1.0/  (B*B)  + 1.0/  (C*C) 

RESONW 

80 

149 

FLOW  = SQRT(FLOW) 

RESONW 

81 

150 

FLOW  = FLOW*CLIGHT/2 . 0 

RESONW 

82 

15  1 

* 

RESONW 

83 

152 

* 

NOW  CALCULATE  HIGH  FREQUENCY  LIMIT 

RESONW 

84 

153 

FHIGH  = 9,0*(  1.0/(A*A)  + 1.0/(B*B)  + 1.0/(C*C)  ) 

RESONW 

85 

154 

FHIGH  = SQRT  (FHIGH) 

RESONW 

86 

155 

FHIGH  = FHIGH*CLIGHT/2 . 0 

RESONW 

87 

156 

IF(FREQ.GE.FLOW  .AND.  FREQ . LE . FHIGH)  THEN 

RESONW 

88 

157 

DREFL  = MREFL 

RESONW 

89 

158 

RETURN 

RESONW 

90 

159 

ELSE 

RESONW 

91 

160 

DREFL  =0.0 

RESONW 

92 

16  1 

GOTO  300 

RESONW 

93 

162 

ENDIF 

RESONW 

94 

163 

END 

RESONW 

95 

VARIABLE 

MAP-- 

(LO=A) 

NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

---SIZE 

A 

346B 

REAL 

AFLAG 

2B 

/ INITILN/ 

REAL 

B 

347B 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR*5 

C 

35  0B 

REAL 

CLIGHT 

363B 

REAL 

DDABS 

OB 

/ROOMD/ 

REAL 

676 

DREFL 

1Z44B 

/ROOMD/ 

REAL 

DREFLW 

1 245B 

/ROOMD/ 

REAL 

FERR 

66B 

/ INITILN/ 

INTEGER 

FHIGH 

365B 

REAL 

FLOW 

364B 

REAL 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FROM 

1 

DUMMY-ARG 

CHAR*3 

FTOT 

67B 

/ INITILN/ 

INTEGER 

IPASS 

361B 

INTEGER 

ISET 

35  5B 

INTEGER 

IWARN 

360B 

INTEGER 

11 

356B 

INTEGER 

MAT 

OB 

/MATC/ 

CHAR»3 

1 00 

MATDESC 

36B 

/MATC/ 

CHAR»70 

100 

MAT  ID 

2 

DUMMY-ARG 

CHAR*3 

MATTEN 

OB 

/MATN/ 

REAL 

700 
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MERR 

4374B 

/MATN/ 

INTEGER 

MFREQ 

3100B 

/MATN/ 

REAL 

700 

MRCOEF 

1 274B 

/MATN/ 

REAL 

700 

MREFL 

3S4B 

REAL 

MTOT 

4375B 

/MATN/ 

INTEGER 

NROOMS 

1 244B 

/ROOMN/ 

INTEGER 

QA 

2570B 

/MATN/ 

REAL 

100 

QR 

2734B 

/MATN/ 

REAL 

100 

QUALITY 

IB 

/ INITILN/ 

INTEGER 

RAREA 

124SB 

/ROOMN/ 

REAL 

20 

RFLAG 

3B 

/ INITILN/ 

REAL 

RH 

35  IB 

REAL 

RL 

352B 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

RW 

35  3B 

REAL 

TMP 

3&2B 

REAL 

WALL 

OB 

/WALLC/ 

CHAR* 3 

300 

WDIM 

OB 

/WALLN/ 

REAL 

225 

WERR 

342B 

/WALLN/ 

INTEGER 

WTOT 

3418 

/WALLN/ 

INTEGER 

•SYMBOLIC 
NAME 

CONSTANTS--! LO=A) 

TYPE 

VALUE 

FMAX 

INTEGER 

50 

MM  AX 

INTEGER 

1 00 

RMAX 

INTEGER 

20 

WMAX 

INTEGER 

75 

PROCEDURES 

i--(LO  = A) 

NAME 

TYPE 

--ARGS 

---CLASS 

RCOEF 

REAL 

3 

FUNCTION 

SORT 

GENERIC 

1 

INTRINSIC 

WARNING  1 SUBROUTINE 


-STATEMENT  LABELS-- ( LO=A ) 


-LABEL-ADDRESS-- 

PROPERTIES- 

---DEF 

100 

INACTIVE 

DO-TERM 

1 03 

200 

102B 

108 

300 

104B 

1 09 

500 

162B 

130 

-ENTRY  POINTS--! 

LO  = A) 

-NAME ADDRESS- 

-ARCS 

RESONW 

5B 

2 

-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

370B 

= 248 

CM  LABELLED  COMMON  LENGTH 

11255B 

= 47  81 

CM  STORAGE  USED 

6 1 OOOB 

= 25088 

COMPILE  TIME 

0 . 1 90 

SECONDS 
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1 SUBROUTINE  RESOND(ID)  RESOND  1 

2 * RESOND  2 

3 • RESOND  3 

4 • THIS  ROUTINE  CALCULATES  RESONANCES  FOR  DOORS  AND  RESOND  4 

5 * WINDOWS  IN  THE  RESONANCE  FREQUENCY  RANGE,  THE  RESOND  5 

6 • INPUT  TRANSMISSION  OF  THE  WINDOW  OR  DOOR  IS  IN-  RESOND  4 

7 * BY  20  DB  (ARBITRARY).  RESOND  7 

8 « RESOND  8 

9 « RESOND  9 

11  **•  COMMON  FOR  ROOM  ARRAY  CONTAINING  ATTENUATION  OF  WALLS  ***COMR  2 

13  INTEGER  RMAE  COMR  4 

14  PARAMETER  (RMAX  = 20)  COMR  5 

15  COMMON  /ROOMN/  ROOM (RMAX  + 6,  RMAX  +6),  NROOMS , RAREA(RMAX)  COMR  4 

16  INTEGER  NROOMS  COMR  7 

17  REAL  ROOM  COMR  8 

21  • COMMON  FOR  ABSORPTION  AND  REFLECTION  COEFFICIENTS  IN  WALLS  COMD  2 

23  COMMON  /ROOMD/DDABSCRMAX  + 6,  RMAX  + 4 ) ,DREFL,  DREFLW  COMD  4 

24  REAL  DDABS  ,DREFL  , DREFLW  COMD  5 

28  ***  COMMON  FOR  INITIAL  PARAMETERS  ***COMF  2 

30  INTEGER  FMAX  COMF  4 

31  PARAMETER  (FMAX  = 50)  COMF  5 

32  COMMON  /INITILN/  FREQ,  QUALITY,  AFLAG,  RFLAG,  FREQA(FMAX),  FERR,  COMF  4 

33  $ FTOT  COMF  7 

34  COMMON  /INITILC/  BLDG  COMF  8 

35  CHARACTER  * 5 BLDG  COMF  9 

36  REAL  FREQ,  AFLAG,  RFLAG,  FREQA  COMF  10 

37  INTEGER  QUALITY,  FERR,  FTOT  COMF  11 

41  ***  COMMON  FOR  DATABASE  OF  TYPES  OF  DOORS  AND  WINDOWS  ***COMT  2 

43  INTEGER  TMAX  COMT  4 

44  PARAMETER  (TMAX=35)  COMT  5 

45  COMMON  /TYPEN/TDIM(TMAX, 4) ,TTOT,TDB2(TMAX,2) ,TDBTOT,TERR  COMT  4 

46  COMMON  /TYPEC/TYPE(TMAX, 3) ,TDB1 (TMAX)  COMT  7 

47  INTEGER  TTOT , TDBTOT , TERR  COMT  8 

48  REAL  TDIH,TDB2  COMT  9 

49  CHARACTER  * 3 TYPE,TDB1  COMT  10 

50  *=================================================  COMT  11 

51  * DESCRIPTION  OF  ARRAYS  COMT  12 

52  *=================================================  COMT  13 

53  * ID  MATERIAL  FRAME  MATERIAL  COMT  14 

54  * COMT  15 

55  *TYFE(X,1)  TYPE(X,2)  TYPE(X,3)  COMT  16 

56  * A3  A3  A3  COMT  17 

57  *=================================================  COMT  18 

58  » HEIGHT  WIDTH  LAYER  DISTANCE  COMT  19 

59  * THICKNESS  ABOVE  FLOOR  COMT  20 

60  » COMT  21 

61  * TDIM(X,1)  TDIM(X,2)  TDIM(X,3)  TDIM(X,4)  COMT  22 

62  * F8.2  F8.2  FB.2  F8.2  COMT  23 

63  *=================================================  COMT  24 

64  * ID  ATTENUATION  AREA  COMT  25 
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INE  RESOND  74/175  OPT=0 

COMT 

COMT 

* TDBKX)  TDB2(X,1)  TDB2(X,2) 

L 0 

27 

67 

* A3  E9.3  E9.3 

COMT 

28 

68 

A********************************************************************  * **COMT 

29 

69 

«*«WA«*lt«lk**«***««***A*****«A««*««**ft**«*lt*«*«**«*«***«***«A*********  **  *CONT 

30 

70 

CHARACTER  * 3,  ID,  MATID 

RESOND 

14 

71 

DO  10  I = 1,  TTOT 

RESOND 

15 

11 

J = I 

RESOND 

16 

73 

IF(TYPE(I,1)  .EQ.  ID)  GOTO  20 

RESOND 

17 

74 

10  CONTINUE 

RESOND 

18 

75 

IVARN  = 11 

RESOND 

19 

76 

CALL  WARNING! IWARN) 

RESOND 

20 

77 

DREFLW  =0.0 

RESOND 

21 

78 

RETURN 

RESOND 

22 

79 

20  CONTINUE 

RESOND 

23 

80 

MATID  = TYPE  (J,3) 

RESOND 

24 

81 

RH  = TD I M ( J , 1 ) 

RESOND 

25 

82 

RW  = TDIM  (J,2> 

RESOND 

26 

83 

REFL  = RCOEF(  MATID,  FREQ,  RFLAG) 

RESOND 

27 

84 

IF(  REFL  .LT.  0.80  ) THEN 

RESOND 

28 

85 

DREFLW  =0.0 

RESOND 

29 

86 

RETURN 

RESOND 

30 

87 

END  IF 

RESOND 

31 

88 

A = RH 

RESOND 

32 

89 

B = RW 

RESOND 

33 

90 

IF(  A.GT.B)  THEN 

RESOND 

34 

91 

TMP  = B 

RESOND 

35 

92 

B = A 

RESOND 

36 

93 

A = TMP 

RESOND 

37 

94 

END  IF 

RESOND 

38 

95 

FLOW  = 3 . 0E8  / 2/  B 

RESOND 

39 

96 

FHIGH  = 3.0E8  / 2.0  * 3.0  * SQRT(  1/(B*B)  + 1 / (A*A)  ) 

RESOND 

40 

97 

IF(FREQ. GE . FLOW  .AND.  FREQ . LE . FH  IGH ) THEN 

RESOND 

41 

98 

DREFLW  =20.0 

RESOND 

42 

99 

ELSE 

RESOND 

43 

100 

DREFLW  =0.0 

RESOND 

44 

10  1 

END  IF 

RESOND 

45 

102 

RETURN 

RESOND 

46 

103 

END 

RESOND 

47 

VARIABLE 

MAP-- 

(LO=A) 

NAME ADDRESS 

--BLOCK PROPERTIES 

TYPE 

A 

205B 

REAL 

AFLAG 

2B 

/ INITILN/ 

REAL 

B 

206B 

REAL 

BLDG 

OB 

/ INITILC/ 

CKAR*5 

DOABS 

OB 

/ROOMD/ 

REAL 

DREFL 

1 244B 

/ROOMD/ 

REAL 

DREFLW 

1 245B 

/ROOMD/ 

REAL 

I'ERR 

66B 

/ INITILN/ 

INTEGER 

FHIGH 

21  IB 

REAL 

FLOW 

210B 

REAL 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

FTOT 

67B 

/ INITILN/ 

INTEGER 

I 

176B 

INTEGER 

ID 

1 

DUMMY-ARG 

CHAR»3 

I WARN 

201B 

INTEGER 

J 

200B 

INTEGER 

MATID 

175B 

CHAR*3 

NROOMS 

124  4B 

/ROOMN/ 

INTEGER 

QUALITY 

IB 

/ INITILN/ 

INTEGER 
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RARCA 

1 2 45B 

/ROOMN/ 

REAL 

20 

REFL 

20  4B 

REAL 

RFLAC 

3B 

/ INITILN/ 

REAL 

RH 

202B 

REAL 

ROOM 

OB 

/ROOMN/ 

REAL 

676 

RW 

20  3B 

REAL 

TDBTOT 

32  3B 

/TYPEN/ 

INTEGER 

TDBl 

37B 

/TYPEC/ 

CHAR*3 

35 

TDB2 

21  SB 

/TYPEN/ 

REAL 

70 

TDIM 

OB 

/TYPEN/ 

REAL 

140 

TERR 

32  4B 

/TYPEN/ 

INTEGER 

TMP 

2 0 7B 

REAL 

TTOT 

21  4B 

/TYPEN/ 

INTEGER 

TYPE 

OB 

/TYPEC/ 

CHAR*3 

1 05 

•SYMBOLIC 

CONSTANTS--! LO=A) 

NAME 

TYPE 

VALUE 

FMAX 

INTEGER 

50 

RMAX 

INTEGER 

20 

TMAX 

INTEGER 

35 

-PROCEDURES 

--(LO=A) 

-NAME 

TYPE 

--ARGS 

CLASS 

RCOEF 

REAL 

3 

FUNCTION 

SORT 

GENERIC 

1 

INTRINSIC 

WARNING 

1 

SUBROUTINE 

-STATEMENT  LABE LS- - ( LO= A ) 


-LABEL-ADDRESS 

--PROPERTIES-- 

--DEF 

1 0 

INACTIVE 

DO-TERM 

74 

20 

43B 

79 

-ENTRY  POINTS--(LO=A) 
-NAME ---ADDRESS --ARCS- -- 

RESOND  5B  1 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH 

214B 

= 140 

CM  LABELLED  COMMON  LENGTH 

3 22  7B 

= 1687 

CM  STORAGE  USED 

61000B 

= 25088 

COMPILE  TIME 

0.120 

SECONDS 
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1 

2 

3 

4 

5 

6 

7 

8 
9 

10 

11 

12 

13 

14 

15 

16 

17 

18 

19 

20 
21 
22 

23 

24 

25 

26 

27 

28 

29 

30 

31 

32 

33 

34 

35 

36 

37 

38 

39 

40 

41 

42 

43 

44 

45 

46 

47 

48 

49 

50 


SUBROUTINE  LFREQ  LFREQ 

* [ C [ C C I C I C C C C C I [ 1 1 1 C [ C [ C C C [ 1 1 [ [ C [ 1 1 1 C [ I C I C [ I [ 1 1 [ [ [ I [ [ C I [ I [ C C C [ I [ 1 1 1 C C C C I LFREQ 
*CCI  [[[LFREQ 

*[[[  LOAD  THE  CONTENTS  OF  THE  FILE  'BXXXXXF'  INTO  ARRAYS  FREQA.  LFREQ 

*[[[  [[[LFREQ 

»[[[[[[ [[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[[LFREQ 


QUALITY,  AFLAC,  RFLAG,  FREQA(FMAX),  FERR, 


COMF 

COMF 

COMF 

COMF 

COMF 

COMF 


***  COMMON  FOR  INITIAL  PARAMETERS  ***COMF 

INTEGER  FMAX 
PARAMETER  (FMAX  = 50) 

COMMON  /INITILN/  FREQ 
5 FTOT 

COMMON  /INITILC/  BLDG 
CHARACTER  * 5 BLDG 
REAL  FREQ,  AFLAC,  RFLAG,  FREQA 
INTEGER  QUALITY,  FERR,  FTOT 

it*********««*ii[**************A*****it**«i*ll*****«**lt************tt*lk******ik*CO)>tp 


****«i***tk******«t**«*****li*******************«i*)lr*** 

* DECLARATION  OF  VARIABLES 

*A**Att**ft**)tltltit*****)t**«***ltlt*I*«*)t**********«***** 

INTEGER  GETLEN,  R,  C 
CHARACTER  * 7 NAME,  PFN 

t 

*k*******)t**k*k******tt*k****lt*t«******t***<Mk***tllk* 

NAME  = ■ B' //BLDG( 1 :GETLEN(BLDG) ) / / ‘ F • 

PFN  = NAME  (1 ;GETLEN(NAME) ) 

FERR  = 0 

CALL  PF  ( ‘GET'  ,0,PFN(UTLEN(PFN)  ), ‘RC  , FERR) 
IF  ( FERR  .EQ.  0 ) THEN 

OPEN  (UNIT=3,  FILE=PFN,  FORM= ' FORMATTED ‘ , 
i STATUS=‘OLD‘ , ACCESS^ ' SEQUENTIAL ' ) 

FTOT  = 0 

DO  10  R = 1,FMAX 

READ  (3,1000,END=20)  FREQA(R) 

1 00  0 FORMAT! El  2. 7) 

FTOT  = FTOT  + 1 
10  CONTINUE 

20  CONTINUE 

C LOSE ( 3, ST ATUS=‘ DELETE’ ) 

ELSE  IF  ( FERR  .EQ.  2 ) THEN 
CALL  WARNING  (11) 

ELSE 

CALL  WARNING  (12) 

END  IF 
RETURN 
END 


COMF 

10 

COMF 

11 

'COMF 

12 

13 

LFREQ 

9 

LFREQ 

10 

LFREQ 

11 

LFREQ 

12 

LFREQ 

13 

LFREQ 

14 

LFREQ 

15 

LFREQ 

16 

LFREQ 

17 

LFREQ 

18 

LFREQ 

19 

REQ 

20 

LFREQ 

21 

LFREQ 

22 

LFREQ 

23 

LFREQ 

24 

LFREQ 

25 

LFREQ 

26 

LFREQ 

27 

LFREQ 

28 

LFREQ 

29 

LFREQ 

30 

LFREQ 

31 

LFREQ 

32 

LFREQ 

33 

LFREQ 

34 

LFREQ 

35 

LFREQ 

36 

LFREQ 

37 

LFREQ 

38 

-VARIABLE 

MAP-- 

( LO=A) 

-NAME ADDRESS 

--BLOCK 

-PROPERTIES 

TYPE 

---SIZE 

AFLAC 

2B 

/ INITILN/ 

REAL 

BLDG 

OB 

/ INITILC/ 

CHAR»5 

C 

NONE 

UNUSED/»S* 

INTEGER 

FERR 

66B 

1 INITI LN/ 

INTEGER 

FREQ 

OB 

/ INITILN/ 

REAL 

FREQA 

4B 

/ INITILN/ 

REAL 

50 

FTOT 

67B 

/ INITILN/ 

INTEGER 

NAME 

21  OB 

CHAR»7 

PFN 

21  IB 

CHAR*7 
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QUALITY  IB  /INITILN/ 

R 20  7B 

RFLAC  3B  /INITILN/ 


INTEGER 

INTEGER 

REAL 


-SYMBOLIC  CONSTANTS-- (LO=A) 


-NAME TYPE VALUE 

FMAI  INTEGER  50 


PROCEDURES--(LO=A) 
NAME TYPE 

CETLEN  INTEGER 

PF 

WARNING 


ARCS CLASS 

1 FUNCTION 

5 SUBROUTINE 

1 SUBROUTINE 


-STATEMENT  LABELS--! LO=A) 


-LABEL- 

ADDRESS 

--PROPERTIES- 

---DEF 

10 

INACTIVE 

DO-TERM 

41 

20 

63B 

42 

1000 

120B 

FORMAT 

39 

-ENTRY  POINTS--(LO=A) 
-NAME ADDRESS --ARCS 

LFREQ  5B  0 


-I/O  UNITS--(LO=A) 
-NAME PROPERTIES- 

TAPE3  AUX/FMT/SEQ 


-STATISTICS-- 


PROGRAM-UNIT  LENGTH  215B  = 141 

CM  LABELLED  COMMON  LENGTH  71B  = 57 


CM  STORAGE  USED 

61000 

B = 25088 

COMPILE  TIME 

0 . 085 

SECONDS 
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Appendix  9.8 


Blank  Forms  for  Data  Taking. 
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WALLS  DATA  FORM 


BUILDING  I.  D.  NUMBER DATE 

NAME 


LINE  ^ 

DIRECTION 

FROM 

TO 

HEIGHT(m) 

WIDTH(m) 

THICKNESS(cm) 

MATERIAL 

COMMENT 

! 

1 
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HOLES  DATA  FORM 


BUILDING  I.D.  NUMBER DATE 

NAME 


LINE  # 

DIRECTION 

FROM 

TO 

ID 

COMMENT 

304 


TYPES  DATA  FORM 


(for  windows  and  doors  ) 


BUILDING  I.D.  NUMBER 


DATE 


NAME 


LINE 

ID 

HEIGHT(m) 

WIDTH(m) 

DISTANCE  ABOVE 
FLOOR 

THICKNESS(cm) 

LAYER 

MATERIAL 

FRAME 

MATERIAL 
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